home *** CD-ROM | disk | FTP | other *** search
/ Whiteline: delta / whiteline CD Series - delta.iso / dl_serie / news / 188 / gfautil4 / gfa_util.hyp (.txt) next >
Atari ST Guide Hypertext  |  1995-11-25  |  301KB  |  9,719 lines
  1. Vorwort
  2. How to use this Hypertext
  3. Bitte an die User
  4. Bitte an die Programmierer
  5. Der gro
  6. e Unbekannte
  7. Manfred Ssykor
  8. Peter Klasen
  9. Neu in dieser Version
  10. 21.09.1995 (PK)
  11. 16.07.1995 (MS)
  12. 05.07.1995 (PK)
  13. Applikationsverwaltung
  14. appl_search()
  15. appl_xgetinfo() (Rosin'sche Variante)
  16. appl_getinfo() (Rosin'sche Variante)
  17. appl_xgetinfo() (R
  18. ger'sche Variante)
  19. Dateiauswahl
  20. FSEL_EXINPUT
  21. Erweitertes fsel_exinput
  22. Selectric
  23. Multifileselect
  24. Multiselect (nach R
  25. Ereignisverwaltung
  26. evnt_multi()
  27. Auf Taste oder Mausklick warten (ohne Auswertung)
  28. Auf Taste warten (mit Auswertung)
  29. Tastenstatus ermitteln
  30. Auf Tastendruck achten (ohne Auswertung)
  31. GEM-Tastaturpuffer l
  32. schen
  33. Messagebuffer l
  34. schen
  35. Maustastenklick l
  36. schen
  37. Abfrage der Alternate-Taste
  38. GEM-Puffer l
  39. schen
  40. (FORM-)INPUT
  41. Fensterverwaltung
  42. Formulare
  43. MODUL Alert
  44. Formatbeschreibung der ALERT-Strings
  45. ALT-Datei laden
  46. ALERT-Meldung ausgeben und auswerten
  47. ALERT-Texte w
  48. hrend der Programmentwicklung 
  49. ndern
  50. lade_programm_alt
  51. alert
  52. change_programm_alt
  53. ALERT-Ersatz als FUNCTION
  54. ALERT-Ersatz als PROCEDURE
  55. RSC im INLINE (Rosin'sche Variante)
  56. RSC im INLINE (Ebsen'sche Variante)
  57. Grafikfunktionen
  58. MODUL Mouse
  59. Defmouse
  60. Busymouse
  61. 5Einbindung und Aufruf in eigenen Programmen
  62. 5Eigene Animationen erstellen
  63. Busymouse Demo
  64. Einfache Busymouse
  65. Einfache Sanduhr
  66. Mausposition ermitteln
  67. Maustastenstatus ermitteln
  68. X-Position ermitteln
  69. Y-Position ermitteln
  70. Mauszeiger verstecken
  71. Mauszeiger aufdecken
  72. SETMOUSE-Ersatz
  73. MOUSE-Offset
  74. Objekte
  75. Resourceorganisation
  76. Menushortcut ermitteln
  77. scan_menu()
  78. Setzen der OB_STATES und OB_FLAGS
  79. rsc_txt_scroll
  80. Shell-Kommunikation
  81. X-Grafikfunktionen
  82. Zwischenspeicher
  83. Clipboard finden (nach Schildmann)
  84. Clipboard finden (nach R
  85. schen des Clipboards
  86. Lesen einer Datei vom Clipboard
  87. GEMDOS
  88. QDateifunktionen
  89. Rf_close()
  90. Rf_out()
  91. Rf_outw()
  92. Rf_outl()
  93. Rf_bput()
  94. Rf_bget()
  95. Rf_print()
  96. Rf_seek()
  97. Rf_loc()
  98. Rf_rename()
  99. Rf_kill()
  100. Rf_rmdir()
  101. Rf_mkdir()
  102. Rf_create()
  103. Rf_open()
  104. Rf_update()
  105. Rf_append()
  106. Rf_lof()
  107. Rf_eof()
  108. Rf_println()
  109. Rf_input()
  110. Rf_bload()
  111. Rf_bsave()
  112. Rfile$()
  113. Rfile.$()
  114. Rext$()
  115. Rpfad$()
  116. Rpfad.$()
  117. Rf_attr()
  118. Rexist()
  119. Rget_fileinfo()
  120. Rexist_drive()
  121. Rexist_ordner()
  122. Rcheck_fastload()
  123. Rset_fastload()
  124. Rprotected()
  125. Rgd_copy()
  126. Rug_copy1()
  127. Rug_copy2()
  128. Rget_alabel$()
  129. Rset_alabel()
  130. Rmain_path$
  131. Rback_up()
  132. Rget_new_file$()
  133. Rordner_holen$()
  134. Rdatei_holen$()
  135. Rdrive_blink()
  136. Rfilename_ext$()
  137. Rset_extend$()
  138. Rset_extension()
  139. Rstr_cut_file$()
  140. Rpfad_format$()
  141. Rfile_to_rsc$()
  142. QDatum und Uhrzeit
  143. QProzessfunktionen
  144. PEXEC-Grundlagen
  145. QSpeicherverwaltung
  146. mxalloc()
  147. QSystemfunktionen
  148. QVerzeichnisfunktionen
  149. diskinfo()
  150. QZeichenweise Ein-/Ausgabe
  151. Attributfunktionen
  152. Ausgabefunktionen
  153. v_gtext()
  154. Auskunftsfunktionen
  155. vq_chcells()
  156. Eingabefunktionen
  157. Escapefunktionen
  158. Kontrollfunktionen
  159. Rasterfunktionen
  160. vdi_copy
  161. Sauberes (S)GET und (S)PUT
  162. Sauberes SGET (als Funktion)
  163. Sauberes SGET (als Prozedur)
  164. Sauberes SPUT (als Prozedur)
  165. Sauberes GET (als Funktion)
  166. Sauberes PUT (als Prozedur)
  167. vdi_copy_init
  168. scr_copy()
  169. make_xyarray()
  170. vro_cpyfm()
  171. Cookies
  172. Cookie ermitteln (nach Rosin)
  173. Cookie ermitteln (nach R
  174. Cookie ermitteln (nach Dunkel)
  175. Cookie ermitteln (nach Harder)
  176. Cookie ermitteln (nach ??)
  177. VSCR-Cookie
  178. Stringmanipulationen
  179. String teilen
  180. String einf
  181. schen eines Teilstrings
  182. Ersetzen in einem String (als Prozedur)
  183. Ersetzen in einem String (als Funktion)
  184. Abschneiden von Leerzeichen
  185. Blocksatz
  186. gen von Dezimalpunkten
  187. gen von Nullen
  188. LOWER$ = Gegenst
  189. ck zu UPPER$
  190. cut_left_str()
  191. llen mit Nullen
  192. Suchen
  193. 'Boyer Moore' Suchalgorythmus
  194. Dateinamen suchen
  195. Suchen in einem eindimensionalen Stringfeld
  196. Suchen in einem Speicherbereich
  197. Suchen (Berger'sche Variante)
  198. Sortieren
  199. Dateinamen sortieren
  200. Sortieren (nach Skuplik)
  201. Routinen rund um's Datum
  202. Datumsroutinen
  203. Der wievielte Tag im Jahr ist heute?
  204. Der wievielte Tag ist heute?
  205. Absolutes Datum -> Kalenderdatum
  206. Welcher Wochentag ist heute?
  207. Differenz zwischen zwei Daten
  208. Rechnet mit Daten
  209. Unix-Datum in echtes Datum wandeln
  210. Zeitdifferenz berechnen
  211. KOBASCH - KOBold-Acc-SCHnitstelle
  212. Dokumentation zu KOBASCH
  213. Beispiel zu KOBASCH
  214. Module OFLS
  215. Module KOBASCH
  216. Prozess-Balken zeichnen
  217. Prozess-Balken (nach Pomrehn)
  218. Prozess-Balken (nach R
  219. Prozess-Balken f
  220. r die FLY-DIALS
  221. Diverses
  222. Ermitteln, ob das Programm im Interpreter gestartet wurde
  223. Ermitteln, ob ein Programm als ACC gestartet wurde
  224. uft das Programm unter MultiTOS?
  225. GFA-VSYSNC-Befehl ersetzen
  226. Systemfehler-Routinen aus bzw. einschalten
  227. Tastaturpuffer l
  228. schen
  229. TOS-Version und -Datum ermitteln
  230. BASEPAGE-Adresse des aktuellen Prozesses
  231. Kalt- oder Warmstart durchf
  232. Kommandozeile (cmd$)
  233. INLINE 2 STRING
  234. Farb-Register retten bzw. restaurieren
  235. BIT-Operation
  236. Aufruf einer Shell
  237. Abfrage der Umschalttasten
  238. CRC-Code berechnen
  239. Debugger
  240. Adressen von GFA-Prozeduren ermitteln
  241. Primzahlen errechnen
  242. Umwandlung: Dezimalzahl in r
  243. mische Zahl
  244. Umwandlung: Dezimalzahl -> 'Zahlwort'
  245. Programmabl
  246. ufe zeitlich begrenzen
  247. GONG ausgeben
  248. xPling ausgeben
  249. Zeilenz
  250. hler (nach Ssykor)
  251. Zeilenz
  252. hler (nach Dunkel)
  253. MagiC-Unfreeze
  254. minfrei
  255. DMA-Sound
  256. Druck-Routine
  257. UFSL-Init
  258. Falcon-Sound
  259. lprint$()
  260. test_printer_online() (nach R
  261. test_printer_online() (nach Duchalski)
  262. MODEM 2
  263. Create Inline Assembler File
  264. Auslesen des $m-Wertes eines Compilates
  265. Multitask-APP???
  266. SPLines
  267. TOS-Cursor
  268. Inlines
  269. ob_spec%
  270. cookie%
  271. crc_code%
  272. sanduhr%
  273. busymouse%
  274. boyer_adr%
  275. ctab%
  276. cntlines%
  277. Andere UUE's
  278. verybusy.uue
  279. prozess.rsc
  280. Protokolle
  281. Drag & Drop (nach Lorenz)
  282. Drag & Drop (nach R
  283. xacc_mtosinit
  284. Index
  285. TOS.HYP/AES
  286. GFA_LDG.HYP
  287. GFA_FAQ.HYP
  288. AOS.HYP
  289. TOS.HYP
  290. aip.hyp\ACC
  291. tos.hyp\AES
  292. aip.hyp\Adresse
  293. aip.hyp\Alexander Lorenz
  294. tos.hyp\Applikationsverwaltung
  295. tos.hyp\Attributfunktionen
  296. tos.hyp\Ausgabefunktionen
  297. tos.hyp\Auskunftsfunktionen
  298. tos.hyp\BIOS
  299. tos.hyp\Bconmap
  300. aip.hyp\Christoph Conrad
  301. aip.hyp\Claus Brod
  302. tos.hyp\Dateiauswahl
  303. tos.hyp\Dateifunktionen
  304. tos.hyp\Datum und Uhrzeit
  305. aip.hyp\David Reitter
  306. tos.hyp\Dcreate
  307. aip.hyp\Doppelklick
  308. tos.hyp\Drvmap
  309. tos.hyp\Eingabefunktionen
  310. tos.hyp\Ereignisverwaltung
  311. tos.hyp\Escapefunktionen
  312. tos.hyp\Fclose
  313. tos.hyp\Fensterverwaltung
  314. aip.hyp\Font-Protokoll
  315. tos.hyp\Fopen
  316. tos.hyp\Formulare
  317. aip.hyp\Franz Sirl
  318. tos.hyp\Fread
  319. tos.hyp\Fsfirst
  320. tos.hyp\Fwrite
  321. tos.hyp\GEM
  322. tos.hyp\GEMDOS
  323. tos.hyp\Grafikfunktionen
  324. aip.hyp\Gregor Duchalski
  325. aip.hyp\HSMODEM
  326. aip.hyp\Harun Scheutzow
  327. aip.hyp\Index
  328. aip.hyp\KILL
  329. aip.hyp\Kobold
  330. tos.hyp\Kontrollfunktionen
  331. aip.hyp\MAX
  332. aip.hyp\MC
  333. tos.hyp\Malloc
  334. aip.hyp\Manfred Ssykor
  335. aip.hyp\Martin Osieka
  336. tos.hyp\Mfree
  337. aip.hyp\Michael Ebsen
  338. aip.hyp\Michael Wedding
  339. tos.hyp\Mxalloc
  340. tos.hyp\NVDI
  341. tos.hyp\Nachrichten
  342. tos.hyp\Objekte
  343. aip.hyp\Oliver Schildmann
  344. tos.hyp\Pause
  345. aip.hyp\Peter Klasen
  346. tos.hyp\Pexec
  347. tos.hyp\Prozessfunktionen
  348. tos.hyp\Rasterfunktionen
  349. aip.hyp\Reiner Rosin
  350. tos.hyp\Resourceorganisation
  351. tos.hyp\Rsconf
  352. aip.hyp\ST-Guide
  353. aip.hyp\Select
  354. tos.hyp\Shell-Kommunikation
  355. tos.hyp\Speicherverwaltung
  356. tos.hyp\Systemfunktionen
  357. aip.hyp\Ulf Dunkel
  358. aip.hyp\Ulli Gruszka
  359. tos.hyp\VDI
  360. tos.hyp\Verzeichnisfunktionen
  361. aip.hyp\WICHTIG
  362. tos.hyp\X-Grafikfunktionen
  363. tos.hyp\XBIOS
  364. aip.hyp\XINFO
  365. tos.hyp\Zeichenweise Ein-/Ausgabe
  366. aip.hyp\Zeig's mir
  367. tos.hyp\Zwischenspeicher
  368. tos.hyp\appl_getinfo
  369. tos.hyp\appl_search
  370. tos.hyp\evnt_multi
  371. tos.hyp\fsel_exinput
  372. tos.hyp\pxyarray
  373. tos.hyp\scrp_clear
  374. tos.hyp\v_gtext
  375. tos.hyp\v_hide_c
  376. tos.hyp\v_show_c
  377. tos.hyp\vq_chcells
  378. tos.hyp\vro_cpyfm
  379. aip.hyp\
  380. Routinen rund um's GFA-Basic
  381. :$VER: Release vom 24. September 1995 (24. September 1995)
  382. -c -i -s +zz -t4
  383. Programmieren/GFA-Basic
  384. #Titel
  385.  Das Betriebssystem TOS
  386.  ATARI Operating System
  387.  Oft gestellte Fragen zum GFA-Basic
  388.  Liste des Grauens
  389.   und 
  390. lVorwort                                                       GFA-Util
  391. Ja, hallo ersteinmal...
  392. Wir wu
  393. ten nicht, ob sie es schon wu
  394. ten, aber das einzigartige GFA-
  395. Util ist ein Kompendium, welches als Hypertext f
  396. r den 
  397. (ST-Guide eine
  398. Sammlung diverser GFABASIC-Routinen beinhaltet, die dem Programmierer
  399. das Leben ein wenig erleichtern k
  400. nnen/sollen (oder auch nich). Wieso
  401. sollte man das Rad immer wieder auf's neue erfinden?
  402. Viel Spa
  403. nschen: 
  404.   und 
  405. lHow to use this Hypertext                                     GFA-Util
  406. Wir haben uns bem
  407. ht, die Listings in diesem Hypertext m
  408. glichst ohne
  409. Umbruch zu gestalten. Leider hat jedoch der 
  410. (ST-Guide (oder besser
  411. gesagt, das 
  412.  ) erhebliche Schwierigkeiten, mit Zeilenl
  413. ngen l
  414. als 127 Zeichen umzugehen.
  415. Um dieses Problem ein wenig zu kompensieren, haben wir uns
  416. entschlossen, hypermegalange Zeilen umzubrechen und sie entsprechend
  417. zu markieren. Diese sind mit #UMBRUCH ANFANG! bzw. #UMBRUCH ENDE!
  418. geklammert. (Sorry, das ist der einzige Weg)
  419. ' #UMBRUCH ANFANG!
  420. dieses_ist_eine_megasuperlange_zeile_die_eigentlich_keinen_
  421. rechten_sinn_erf
  422. llt_aber_immerhin_l
  423. nger_als_
  424. einhundersiebenunzwanzig_zeichen_ist_um_zu_demonstieren_
  425. wie_der_umruch_funxioniert=2039
  426. ' #UMBRUCH ENDE!
  427. lBitte an die User                                             GFA-Util
  428. Falls Ihr bemerkt, da
  429.  eine (oder mehrere) Routinen fehlerhaft sind,
  430. postet uns das schnellstm
  431. glich, damit diese nicht weiter verbreitet
  432. werden.
  433. lBitte an die Programmierer                                    GFA-Util
  434. Habt Ihr eine (oder mehrere) interessante Routinen f
  435. r diese Library,
  436. rden wir uns sehr freuen, diese in der n
  437. chsten Version mit
  438. ffentlichen zu d
  439. rfen. Diese k
  440. nnen wahlweise an 
  441. AC3 oder 
  442.   @ KR geschickt werden. Wenn das per eMail
  443. geschieht, dann bitte vorher 
  444. lpacken
  445. d (LZH, ZIP, ARC, ZOO) und
  446. UUEncoden, damit nicht aus versehen Zeilen umgebrochen werden.
  447. Schanke d
  448. r die Merkaufkeitsam.
  449. lDer gro
  450. e Unbekannte                                          GFA-Util
  451. r diese Routinen haben wir noch niemanden finden k
  452. nnen, der sich
  453. ffentlich bekannt hat, sie verbrochen zu haben.
  454. Falls Du jemanden kennst, der jemanden kennt, dessen Bruder/Onkel/Opa
  455. diese Listings geschrieben hat, dann schick' uns doch bitte
  456. schleunigst eine Mail.
  457. lManfred Ssykor                                                GFA-Util
  458.                               Manfred Ssykor
  459.                               H
  460. ttenstrasse 46
  461.                               D-52068 Aachen
  462.                               Telefon: 0241/953703
  463.                               eMail: Manfred Ssykor @ AC3
  464.                                      manfred_ssykor@ac3.maus.de
  465.                                      msy@lafp.tng.oche.de
  466. lPeter Klasen                                                  GFA-Util
  467. Peter Klasen
  468. Lindemannstr.25
  469. D-40237 D
  470. sseldorf
  471. Telefon: 0211/678613
  472. eMail: Peter Klasen @ KR
  473.        peter_klasen@kr.maus.de
  474.                                    (Selps-Potr
  475. lNeu in dieser Version                                         GFA-Util
  476.  2.1 
  477.  2.2 
  478.  2.3 
  479. l21.09.1995 (PK)                                               GFA-Util
  480. chz! Als mich mal wieder besonders die Langeweile plagte, habe ich
  481. meine CAT-Messagebase mit 
  482. ber 3723 Mails zum Thema GFA-Basic
  483. durchsucht und bin auf die ein oder andere interessante Routine
  484. gestossen, die ich Euch nicht vorenthalten will. Insgesamt wurden ca.
  485. 30 neue Listings eingef
  486. gt, die ich an dieser Stelle
  487. (verst
  488. ndlicherweise) nicht auff
  489. hren m
  490. chte.
  491. Des weiteren wurde GFA-Util stark umstrukturiert und optisch ein
  492. wenig aufgepeppt. Die GFA-Faq sowie die Liste des Grauens werden nun
  493. von Joachim Hurst @ B gepflegt und sind somit aus der GFA-Util
  494. verbannt worden.
  495. Jetzt liegt's am Manni, meine sorgsam versteckten Fehler zu entdecken
  496. und zu eliminieren ;-)
  497. Ach ja: Fall in diesem Text hier und da mal ein 's' fehlen ollte, o
  498. liegt da an meiner vor Zigarettenache trotzenden Tatatur ;-)
  499. l16.07.1995 (MS)                                               GFA-Util
  500. Nun, was ist neu?
  501.  exist                      Existenz einer Datei 
  502. berpr
  503.                    Neue Busymouseroutine von 
  504. ,Ulli Gruszka @
  505.                             DO eingebaut. Ich (Manfred) habe noch ein
  506.                             paar weitere Animationen in 
  507.                             eingef
  508.                        
  509.   Da dies f
  510.   ben
  511. tigt wird und
  512.                             
  513. *Ulf Dunkel @ CLP das aber nicht
  514.                             mitgepostet hat, habe ich (Manfred) das
  515.                             schnell zusammengehackt.
  516.  changes                    Diverse kleine 
  517. nderungen am "Quellcode"
  518.                             zu GFA_UTIL.HYP
  519. l05.07.1995 (PK)                                               GFA-Util
  520. Peter Harder @ NF war so freundlich uns folgende Routinen zuzusenden:
  521. )vro_cpyfm()
  522.  Das Betriebssystem TOS: AES
  523. lAES                                                           GFA-Util
  524.   (appl_...)
  525.             (fsel_...)
  526.       (evnt_...)
  527.        (wind_...)
  528.                (form_...)
  529.         (graf_...)
  530.                    (menu_...)
  531.                  (objc_...)
  532.     (rsrc_...)
  533.      (shel_...)
  534.       (xgrf_...)
  535.         (scrp_...)
  536. lApplikationsverwaltung                                        GFA-Util
  537. lappl_search()                                                 GFA-Util
  538. Autor: Frank R
  539. ger @ OS2
  540. eFrage:
  541. d wie bekomme ich die Namen der Accessories heraus, die aktuell
  542.     im System vorhanden sind?
  543. eAntwort:
  544. d Ab 
  545.   4.0 (also praktisch derzeit nur unter MultiTOS und
  546.     MagiC3) mit appl_search(), etwa so:
  547. DIM acc_namen$(50),acc_ids&(50) ! oder so ...
  548. CLR acc_num&,ap_smode&
  549. WHILE @
  550. +appl_search(ap_smode&,ap_sname$,ap_stype&,ap_sid&)
  551.   IF ap_stype&=4  ! Accessory
  552.     acc_namen$(acc_num&)=ap_sname$
  553.     acc_ids&(acc_num&)=ap_sid&
  554.     INC acc_num&
  555.   ENDIF
  556.   ap_smode&=1
  557. FOR i&=0 TO PRED(acc_num&)
  558.   PRINT "'";acc_namen$(i&);"'",acc_ids&(i&)
  559. NEXT i&
  560. ~INP(2)
  561. FUNCTION 
  562. +appl_search(ap_smode&,VAR ap_sname$,ap_stype&,ap_sid&)
  563.   $F%
  564.   ap_sname$=STRING$(9,0)
  565.   GCONTRL(0)=18
  566.   GCONTRL(1)=1
  567.   GCONTRL(2)=3
  568.   GCONTRL(3)=1
  569.   GCONTRL(4)=0
  570.   GINTIN(0)=ap_smode&
  571.   ADDRIN(0)=V:ap_sname$
  572.   GEMSYS
  573.   ap_sname$=CHAR{V:ap_sname$}
  574.   ap_stype&=GINTOUT(1)
  575.   ap_sid&=GINTOUT(2)
  576.   RETURN GINTOUT(0)
  577. ENDFUNC
  578. lappl_xgetinfo() (Rosin'sche Variante)                         GFA-Util
  579. Autor: 
  580. ,Reiner Rosin @ WI2
  581. Siehe auch: 
  582. DEFINT "a-z"
  583. ret=FN appl_xgetinfo(4,a,b,c,d)
  584. IF has_agi=1
  585.   ALERT 1,"
  586. ,appl_getinfo vorhanden",1,"OK",ok
  587.   IF ret=0
  588.     ALERT 1,"Fkt 4 nicht|vorhanden",1,"OK",ok
  589.   ELSE
  590.     ALERT 1,STR$(a)+"|"+STR$(b)+"|"+STR$(c)+"|"+STR$(d),1,"OK",ok
  591.   ENDIF
  592.   ALERT 1,"
  593. ,appl_getinfo|nicht vorhanden",1,"OK",ok
  594. ENDIF
  595. FUNCTION appl_xgetinfo(type,VAR out1,out2,out3,out4)
  596.   REM
  597.   REM
  598.   REM  Modul: appl_xgetinfo
  599.   REM
  600.   REM         V1.0 vom 30.3.94
  601.   REM         (c) 
  602. ,Reiner Rosin @ WI2
  603.   REM
  604.   REM Pr
  605. ft, ob 
  606. ,appl_getinfo() (="agi") vorhanden ist und ruft es ggfs auf.
  607.   REM
  608.   REM Parameter: type = gew
  609. nschte Subfunktion
  610.   REM            out1...out4 = R
  611. ckgabevariablen f
  612. r agi-Ergebnisse
  613.   REM
  614.   REM R
  615. ckgabe:  flag =  0 - agi nicht vorhanden oder Subfunktion type nicht
  616.   REM                        implementiert
  617.   REM      oder  flag <> 0 - R
  618. ckgabe der Subfunktion
  619.   REM
  620.   LOCAL flag,wert,aes&,z
  621.   IF has_agi=0        ! agi noch nicht 
  622. berpr
  623.     aes&=WORD{{GB+4}}
  624.     IF aes&>=&H400    ! 
  625.   ab 4.00: immer mit agi
  626.       has_agi=1
  627.     ELSE
  628.       IF aes&=&H399                         ! 
  629.   3.99
  630.         GOSUB 
  631. ,test_cookie("MagX",flag,wert)
  632.         IF flag                             ! Mag!X installiert
  633.           IF {{wert+8}}=&H87654321
  634.             IF {wert+8}                     ! AESVARS vorhanden
  635.               IF WORD{{wert+8}+42}>=&H200
  636.                 has_agi=1
  637.               ENDIF
  638.             ENDIF
  639.           ENDIF
  640.         ENDIF
  641.       ENDIF
  642.       '
  643.       IF has_agi=0
  644.         IF APPL_FIND("?AGI")=0             ! Vorschlag von 
  645. -Martin Osieka
  646.           has_agi=1
  647.         ELSE IF WIND_GET(0,22360,z,z,z,z)=22360  ! WINX pr
  648.           has_agi=1
  649.         ELSE
  650.           has_agi=-1                       ! kein agi vorhanden
  651.         ENDIF
  652.         '
  653.       ENDIF
  654.     ENDIF
  655.   ENDIF
  656.   IF has_agi>0
  657.     RETURN FN 
  658. ,appl_getinfo(type,out1,out2,out3,out4)
  659.   ELSE
  660.     RETURN 0
  661.   ENDIF
  662. ENDFUNC
  663. lappl_getinfo() (Rosin'sche Variante)                          GFA-Util
  664. Autor: 
  665. ,Reiner Rosin @ WI2
  666. FUNCTION 
  667. ,appl_getinfo(type,VAR out1,out2,out3,out4)
  668.   REM
  669.   REM
  670.   REM  Modul: 
  671. ,appl_getinfo
  672.   REM
  673.   REM         V1.0 vom 30.3.94
  674.   REM         (c) 
  675. ,Reiner Rosin @ WI2
  676.   REM
  677.   REM Binding f
  678. ,appl_getinfo
  679.   REM
  680.   REM Parameter: type = gew
  681. nschte Subfunktion
  682.   REM            out1...out4 = R
  683. ckgabevariablen f
  684. r agi-Ergebnisse
  685.   REM
  686.   REM R
  687. ckgabe:  flag =  0 - Subfunktion type nicht implementiert
  688.   REM      oder  flag <> 0 - R
  689. ckgabe der Subfunktion
  690.   REM
  691.   GCONTRL(0)=130
  692.   GCONTRL(1)=0
  693.   GCONTRL(2)=5
  694.   GCONTRL(3)=0
  695.   GCONTRL(4)=0
  696.   GINTIN(0)=type
  697.   GEMSYS
  698.   out1=GINTOUT(1)
  699.   out2=GINTOUT(2)
  700.   out3=GINTOUT(3)
  701.   out4=GINTOUT(4)
  702.   RETURN GINTOUT(0)
  703. ENDFUNC
  704. lappl_xgetinfo() (R
  705. ger'sche Variante)                         GFA-Util
  706. Autor: Frank R
  707. ger @ OS2
  708. Siehe auch: 
  709. FUNCTION appl_xgetinfo(ap_gtype&,VAR ap_gout1&,ap_gout2&,ap_gout3&,ap_gout4&)
  710.   $F%
  711.   LOCAL back&
  712.   IF ap_version&>=&H400 OR magx_version%>=&H200 OR winx! OR APPL_FIND("?AGI")=0
  713.     GINTIN(0)=ap_gtype&
  714.     GCONTRL(0)=
  715. ,appl_getinfo&
  716.     GCONTRL(1)=1
  717.     GCONTRL(2)=5
  718.     GCONTRL(3)=0
  719.     GCONTRL(4)=0
  720.     GEMSYS
  721.     ap_gout1&=GINTOUT(1)
  722.     ap_gout2&=GINTOUT(2)
  723.     ap_gout3&=GINTOUT(3)
  724.     ap_gout4&=GINTOUT(4)
  725.     back&=GINTOUT(0)
  726.   ENDIF
  727.   IF back&=0
  728.     ap_gout1&=0
  729.     ap_gout2&=0
  730.     ap_gout3&=0
  731.     ap_gout4&=0
  732.   ENDIF
  733.   RETURN back&
  734. ENDFUNC
  735. lDateiauswahl                                                  GFA-Util
  736. lFSEL_EXINPUT                                                  GFA-Util
  737. Autor: 
  738.   @ XYZ
  739. ' Aufruf von FSEL_EXINPUT...
  740. > FUNCTION fileselect$(a$,pfad$,file$)
  741.   LOCAL f&,b&
  742.   ~WIND_UPDATE(1)                           ! BEG_UPDATE
  743.   IF INT{ADD({ADD(GB,4)},0)}<&H140          ! Altes 
  744. #GEM/TOS...
  745.    f&=FSEL_INPUT(pfad$,file$,b&)
  746.   ELSE                                      ! Sonst mit Titelzeile...
  747.    f&=@
  748. ,fsel_exinput(a$,pfad$,file$,b&)
  749.   ENDIF
  750.   ~WIND_UPDATE(0)                           ! END_UPDATE
  751.   IF f&=0 OR b&=0                           ! Abbruch oder Error...
  752.    RETURN ""
  753.   ENDIF
  754.   RETURN LEFT$(pfad$,RINSTR(pfad$,"\"))+file$
  755. ENDFUNC
  756. > FUNCTION 
  757. ,fsel_exinput(a$,VAR pfad$,file$,b&)
  758.   $F%
  759.   a$=a$+CHR$(0)         ! Titel
  760.   pfad$=pfad$+CHR$(0)+SPACE$(400)
  761.   file$=file$+CHR$(0)+SPACE$(150)
  762.   GCONTRL(0)=91
  763.   GCONTRL(1)=0
  764.   GCONTRL(2)=2
  765.   GCONTRL(3)=3
  766.   GCONTRL(4)=0
  767.   ADDRIN(0)=V:pfad$     ! Pfad
  768.   ADDRIN(1)=V:file$     ! Datei
  769.   ADDRIN(2)=V:a$        ! Titel
  770.   GEMSYS
  771.   pfad$=CHAR{V:pfad$}   ! Pfad
  772.   file$=CHAR{V:file$}   ! Dateiname
  773.   b&=GINTOUT(1)         ! Abbruch=0, OK=1
  774.   RETURN GINTOUT(0)     ! Fehlercode
  775. ENDFUNC
  776. lErweitertes 
  777. ,fsel_exinput                                      GFA-Util
  778. Autor: Harald Ax @ ??, 
  779.   @ AC3
  780. Siehe auch '
  781. ,find_cookie()'
  782. ' LINE-A freier Fileselect-aufruf!
  783. ' Die GFA-Befehle 'FILESELECT' und 'FILESELECT #' sind LINA-A behaftet!
  784. ' Bei dieser Funtion kann IMMER ein 'Kommentar' f
  785. r die FSEL 
  786. bergeben
  787. ' werden. Ben
  788. tigt wird noch die Function 'suche_cookie'!
  789. > PROCEDURE fileselect(info$,msk$,set_ext|,VAR path$,file$,button|)
  790.   ' Version 3.4 vom 23.03.1993 by Harald Ax
  791.   ' (
  792. berarbeitet von 
  793.   ' info$    >| 
  794. berschrift, max. 30 Zeichen
  795.   ' msk$     >| gew
  796. nschte Maske (incl. Extension). Standard: "*.*"
  797.   ' set_ext| >| in msk$ definierte Extension an Dateiname anh
  798. ngen:
  799.   '             0: nicht; 1: immer; 2: nur, wenn keine eingegeben wurde
  800.   ' path$    >|>Suchpfad ohne(!) Suchmaske
  801.   ' file$    >|>reiner Dateiname. Der komplette Dateiname kann aus
  802.   '             path$ + file$ zusammengesetzt werden.
  803.   ' button|   |>0: ABBRUCH angeclickt; 1: OK angeclickt;
  804.   '             2: OK angeclickt, aber kein Dateiname ausgew
  805.   ' >| = Input; |> = Output; >|> Input + Output
  806.   LOCAL pos&,fpath$,gem&
  807.   ' Vorarbeiten:
  808.   info$=LEFT$(info$,30)                 !L
  809. ngenbegrenzung 
  810. berschrift
  811.   IF msk$=""
  812.     msk$="*.*"                          !Standard-Suchmaske
  813.   ENDIF
  814.   msk$=UPPER$(msk$)
  815.   ext$=MID$(msk$,RINSTR(msk$,".")+1)
  816.   ' ^ Extension aus msk$ herausfiltern
  817.   set_ext|=ABS(set_ext|)
  818.   ' ^ Anpassen, falls jemand mit TRUE arbeitet
  819.   path$=LEFT$(path$,RINSTR(path$,"\"))
  820.   ' ^ Zur Sicherheit, falls doch eine Extension 
  821. bergeben wurde
  822.   IF path$=""
  823.     path$=home$                         !Standard-Suchpfad
  824.   ENDIF
  825.   ' ---Die Betriebssystemroutine aufrufen:
  826.   gem&=CARD{LONG{GB+4}}
  827.   fpath$=path$+msk$+STRING$(131,0)    !Kpl. Pfad incl. Suchmaske
  828.   info$=info$+CHR$(0)
  829.   file$=file$+STRING$(21,0)           !Dateiname (Vorgabe)
  830.   GCONTRL(1)=0
  831.   GCONTRL(2)=2
  832.   GCONTRL(4)=0
  833.   ADDRIN(0)=V:fpath$                    !Pfad
  834.   ADDRIN(1)=V:file$                     !Dateiname (Vorgabe)
  835.   IF gem&>=&H140 OR @
  836. ,find_cookie("FSEL")
  837.     GCONTRL(3)=3
  838.     ADDRIN(2)=V:info$               !Infozeile
  839.     GEMSYS 91                       !
  840.   91) aufrufen
  841.   ELSE
  842.     GCONTRL(3)=2
  843.     GEMSYS 90                       !FSEL_INPUT (
  844.   90) aufrufen
  845.   ENDIF
  846.   ' ---Auslesen
  847.   button|=GINTOUT(1)
  848.   ' ^ Ausgew
  849. hlter Button: 0=ABBRUCH, 1=OK
  850.   file$=CHAR{ADDRIN(1)}
  851.   ' ^ Ausgew
  852. hlter Dateiname
  853.   fpath$=CHAR{ADDRIN(0)}
  854.   ' ^ Ausgew
  855. hlter Pfad incl. Suchmaske
  856.   IF button|=1                          !OK angeclickt?
  857.     ' -> fpath$ auftrennen in Pfad und Suchmaske
  858.     pos&=RINSTR(fpath$,"\")             !Position des letzten "\"
  859.     path$=LEFT$(fpath$,pos&)            !Suchpfad
  860.     IF LEN(file$)>0                     !
  861. berhaupt Dateiname angegeben?
  862.       IF set_ext|>0                     !Evtl. ext$ anh
  863.         pos&=RINSTR(file$,".")          !Position des letzten "."
  864.         IF pos&=0                       !Kein "." im Dateiname vorhanden
  865.           file$=file$+"."
  866.           pos&=LEN(file$)               !pos& anpassen
  867.         ENDIF
  868.         IF set_ext|=1                  !ext$ unbedingt anh
  869. ngen ->
  870.           file$=LEFT$(file$,pos&)+ext$ !->Ausgew
  871. hlte Ext. abschneiden
  872.         ENDIF
  873.         ' Bis hierher wurde file$ so aufbereitet, da
  874.  auch bei set_ext|=2
  875.         ' die Zwangs-Extension angeh
  876. ngt werden kann.
  877.         IF RIGHT$(file$)="."            !Dateiname ohne Extension?
  878.           file$=file$+ext$              !Dateiname incl. Zwangs-Ext.
  879.         ENDIF
  880.       ENDIF
  881.       IF RIGHT$(file$)="."
  882.         ' ^ Evtl. Punkt bei Dateiname ohne Ext. abschneiden
  883.         '
  884.         file$=LEFT$(file$,LEN(file$)-1)
  885.       ENDIF
  886.     ELSE                                !Kein Dateiname ausgew
  887.       button|=2
  888.       CLR file$
  889.     ENDIF
  890.   ENDIF
  891.   ~FRE(0)                               !Garbage-Collection
  892. RETURN
  893. lSelectric                                                     GFA-Util
  894. Autor: Frank R
  895. ger @ OS2
  896. Hi Selectricer!
  897. Ich habe mich auch mal ein wenig mit der Programmierschnittstelle von
  898. Selectric besch
  899. ftigt und dabei folgende PROCs entwickelt, die fast
  900. er 44 Bytes f
  901. r DTA) ohne Speicheranforderungen auskommen! Diese
  902. PROCs sind v
  903. llig unsauber (gerade im Interpreter zusammengehackt;-)
  904. aber es soll ja auch nur der Zugriff auf die cdecl-Funktionen von
  905. Selectric demonstriert werden. Vorteil: Die 
  906. bergebenen Dateien
  907. nnen direkt 
  908. ber FSFIRST/FSNEXT-
  909. hnliche Funktionen aus einer DTA-
  910. kompatiblen Struktur ausgelesen werden. Au
  911. erdem kann man die Auswahl
  912. auf bestimmte Dateiattribute beschr
  913. nken.
  914. PROCEDURE multislct_demo(pfadmaske$,vorgabe$,attrib&,max&)
  915.   LOCAL files&,dta%,dta_attrib&,pfad$,fname$,back$
  916.   CLS  !igitt, aber wenn ich schon PRINT benutze... :-)
  917.   init_slct(slct_on!,multislct!)
  918.   IF slct_on!
  919.     PRINT "Selectric vorhanden und eingeschaltet ..."
  920.     IF multislct!
  921.      ~WIND_UPDATE(3) !Wichtig, siehe SLCTPROG.TXT/SAMPLE.C
  922.       DIM dta%(10)   !44 Bytes Pseudo-DTA
  923.       dta%=V:dta%(0)
  924.       slct_comm&=&X1001  !CMD_FILES_OUT (1) + CFG_FIRSTNEXT (8)
  925.       FILESELECT #"Mehrfache Datei
  926. bergabe!",pfadmaske$,vorgabe$,back$
  927.       ' ^^^ hier nat
  928. rlich 
  929.       '
  930.       IF LEN(back$)
  931.         pfad$=LEFT$(back$,RINSTR(back$,"\"))
  932.         IF C:slct_get_first%(L:dta%,attrib&)=0
  933.           REPEAT
  934.             INC files&
  935.             fname$=pfad$+CHAR{dta%+30}
  936.             dta_attrib&=BYTE{dta%+21}
  937.             IF BTST(dta_attrib&,4)  !Ordner
  938.               fname$=fname$+"\"
  939.             ENDIF
  940.             PRINT "Name: ";fname$
  941.             ' PRINT "L
  942. nge: ";{dta%+26}
  943.             ' PRINT "Attribute: ";BIN$(dta_attrib&,6)
  944.           UNTIL C:slct_get_next%(L:dta%)<>0 OR files&=max&
  945.           ' wird -49, wenn keine weitere Datei vorhanden!
  946.         ELSE IF BTST(attrib&,4)
  947.           files&=1
  948.           PRINT "Name: ";pfad$
  949.         ENDIF
  950.       ELSE
  951.         PRINT "Abbruch gew
  952. hlt!"
  953.       ENDIF
  954.       ~C:slct_release_dir%()  !Aufr
  955.       ERASE dta%()
  956.       PRINT "Es wurden ";files&;" Files 
  957. bergeben!"
  958.       ~WIND_UPDATE(2)
  959.     ELSE
  960.       PRINT "... aber zu alt f
  961. r diese Demo!"
  962.     ENDIF
  963.   ELSE
  964.     PRINT "Selectric nicht vorhanden oder ausgeschaltet!"
  965.   ENDIF
  966. RETURN
  967. PROCEDURE init_slct(VAR slct_on!,multislct!)
  968.   LOCAL slct_version%,slct_adr%
  969.   CLR slct_on!,multislct!
  970.   IF @
  971. +get_cookie("FSEL",slct_adr%)
  972.     IF slct_adr%>0 AND EVEN(slct_adr%)
  973.       IF MKL$(LPEEK(slct_adr%))="SLCT"
  974.         '
  975.         ' Konfig-WORD (Long-Variable, da unsigned):
  976.         slct_config%=CARD{slct_adr%+6}
  977.         '
  978.         ' Selectric ON/OFF?:
  979.         slct_on!=BTST(slct_config%,0)
  980.         '
  981.         IF slct_on!
  982.           '
  983.           ' Version im BCD-Format:
  984.           slct_version%=CARD{slct_adr%+4}
  985.           '
  986.           ' cdecl-Funktionen erst ab Selectric 1.02
  987.           multislct!=slct_version%>=&H102
  988.           '
  989.           IF multislct!
  990.             '
  991.             ' Kommunikations-WORD (Direktzugriff per ABSOLUTE):
  992.             ABSOLUTE slct_comm&,slct_adr%+22  !GLOBAL
  993.             '
  994.             ' Zeiger auf get_first():
  995.             slct_get_first%={slct_adr%+36}
  996.             ' Aufruf: rueck%=C:slct_get_first%(L:dta%,attrib&)
  997.             '
  998.             ' Zeiger auf get_next():
  999.             slct_get_next%={slct_adr%+40}
  1000.             ' Aufruf: rueck%=C:slct_get_next(L:dta%)
  1001.             '
  1002.             ' Zeiger auf release_dir():
  1003.             slct_release_dir%={slct_adr%+44}
  1004.             ' Aufruf: rueck%=C:slct_release_dir%()
  1005.             '
  1006.           ENDIF
  1007.         ENDIF
  1008.       ENDIF
  1009.     ENDIF
  1010.   ENDIF
  1011. RETURN
  1012. Zur Weiterentwicklung freigegeben :-)
  1013. Das ganze mu
  1014.  noch richtig ausgearbeitet werden (Funktionen mit
  1015. ckgabewerten, Sammeln der 
  1016. bergebenen Dateinamen in einem
  1017. Stringarray o.
  1018. ., Alternativfunktionen, wenn slct_on!=FALSE oder
  1019. multislct!=FALSE, Speicherschutz, Fehlerbehandlung usw.)! Evtl. mu
  1020. man auch die Compileroption $C+ setzen (ich wei
  1021.  nicht, ob A3-A6
  1022. ndert werden)!
  1023. lMultifileselect                                               GFA-Util
  1024. Autor: 
  1025. ,Reiner Rosin @ WI2
  1026. DEFINT "a-z"
  1027. RESERVE 100000 ! Speicher freigeben (it's unsauber, ich wei
  1028.  -> hier
  1029. '              ! nurDemo!))
  1030. GOSUB multi_fileselect("Mach hin!","E:\*.IMG","TEST.IMG",10)
  1031. PROCEDURE multi_fileselect(titel$,pfad$,datei$,anzahl)
  1032.   ' Multi-Fileselect
  1033.   ' V1.0 vom 25.12.1992
  1034.   '  ********* modifiziert f
  1035. *Zeig's mir!*****
  1036.   ' Aufgabe: gestattet es, zusammen mit 
  1037.   mehrere Dateien zu
  1038.   '          selektieren
  1039.   ' Parameter:
  1040.   ' titel$       . Titelzeile in der Fileselectbox, wie bei FILESELECT
  1041.   ' pfad$        . Pfad und Maske, wie bei FILESELECT
  1042.   ' datei$       . Vorbelegung, wie bei FILESELECT
  1043.   ' anzahl       . Anzahl max. zul
  1044. ssiger Dateien
  1045.   LOCAL flag,fsel_struct,z$,z2$,p,z,n2,ram,n
  1046.   ' Einschr
  1047. nkungen in der aktuellen Version
  1048.   ' - max 120 Dateien selektierbar, denn viel mehr als 120*256=30720
  1049.   '   passen nicht in einen String
  1050.   '                  (im Desktop k
  1051. nnen Pfadnamen bis zu   ^^^ 256
  1052.   '                    Byte lang werden)
  1053.   ' - die Anzahl der Selektierungen ist auf 120 beschr
  1054.   '   selektiert man also 20 Ordner + 130 Dateien, dann
  1055.   '   bleiben effektiv u.U. nur 120 - 20 (Ordnerzahl) = 100 Dateien
  1056.   '   
  1057. brig!
  1058.   anzahl=MIN(anzahl,120)
  1059. ,test_cookie("FSEL",flag,fsel_struct)
  1060.   IF flag
  1061.     IF LPEEK(fsel_struct)=CVL("SLCT")
  1062.       IF BTST(DPEEK(fsel_struct+6),0)
  1063.         flag=1
  1064.       ELSE
  1065.         flag=0
  1066.       ENDIF
  1067.     ELSE
  1068.       flag=0
  1069.     ENDIF
  1070.   ENDIF
  1071.   IF flag=0
  1072.     GOSUB fileselect(titel$,pfad$,datei$,z$,ok)
  1073.     IF ok
  1074.       @add_liste(z$)
  1075.     ENDIF
  1076.   ELSE
  1077.     '
  1078.     DPOKE fsel_struct+22,3
  1079.     DPOKE fsel_struct+30,120
  1080.     '
  1081.     @malloc(0,32000,32000,ram,z)
  1082.     z2$=SPACE$(32000)
  1083.     IF ram>0
  1084.       BMOVE VARPTR(z2$),ram,32000
  1085.       LPOKE fsel_struct+32,ram
  1086.       GOSUB fileselect(titel$,pfad$,datei$,z$,ok)
  1087.       BMOVE ram,VARPTR(z2$),32000
  1088.       GOSUB mfree(ram)
  1089.     ELSE
  1090.       IF debug                                                  ! -Deb
  1091.         PRINT CHR$(7);                                          ! -Deb
  1092.         GOSUB output_infofenster(19,"Riskanter FILESELECT!")    ! -Deb
  1093.       ENDIF                                                     ! -Deb
  1094.       LPOKE fsel_struct+32,VARPTR(z2$)
  1095.       @fileselect(titel$,pfad$,datei$,z$,ok)
  1096.     ENDIF
  1097.     n=DPEEK(fsel_struct+30)
  1098.     '
  1099.     IF ok=1
  1100.       IF n>0
  1101.         GOSUB zerlege_dateiname(z$,pfad$,z$)
  1102.         p=1
  1103.         n2=0
  1104.         REPEAT
  1105.           z=INSTR(z2$,CHR$(32),p)
  1106.           z$=MID$(z2$,p,z-p)
  1107.           WHILE RIGHT$(z$,1)=CHR$(0)
  1108.             z$=LEFT$(z$,LEN(z$)-1)
  1109.           WEND
  1110.           p=z+1
  1111.           INC n2
  1112.           GOSUB add_liste(pfad$+z$)
  1113.         UNTIL n2>=n OR n2=anzahl
  1114.       ELSE
  1115.         GOSUB add_liste(z$)
  1116.       ENDIF
  1117.     ENDIF
  1118.   ENDIF
  1119. RETURN
  1120. PROCEDURE fileselect(titel$,pfad$,datei$,VAR auswahl$,button)
  1121.   ' Kam irgendwann mal in einer Maus-Mail
  1122.   LOCAL puffer,gem_v,flag,fsel_struct
  1123.   INLINE puffer,190
  1124.   GOSUB sie("FSEL",flag,fsel_struct)
  1125.   CHAR{puffer}=pfad$
  1126.   CHAR{puffer+140}=LEFT$(datei$,19)
  1127.   CHAR{puffer+160}=LEFT$(titel$,29)
  1128.   gem_v=CARD{LONG{GB+4}}                !
  1129. #GEM-Version
  1130.   ' ---Initialisieren + Aufrufen der Fileselectbox
  1131.   GCONTRL(1)=0
  1132.   GCONTRL(2)=2
  1133.   GCONTRL(4)=0
  1134.   ADDRIN(0)=puffer
  1135.   ADDRIN(1)=puffer+140
  1136.   IF ((gem_v>=&H140 AND gem_v<&H200) OR gem_v>&H300) OR flag<>0
  1137.     GCONTRL(3)=3
  1138.     ADDRIN(2)=puffer+160
  1139.     GEMSYS 91                         !Entspricht FILESELECT#...
  1140.   ELSE
  1141.     GCONTRL(3)=2
  1142.     GEMSYS 90                         !Entspricht FILESELECT ...
  1143.   ENDIF
  1144.   ' ---Auslesen der Fileselectbox
  1145.   button=GINTOUT(1)                  !Ausgangs-Button
  1146.   GOSUB zerlege_dateiname(CHAR{ADDRIN(0)},auswahl$,datei$)
  1147.   auswahl$=auswahl$+CHAR{ADDRIN(1)}
  1148. RETURN
  1149. PROCEDURE zerlege_dateiname(file$,VAR pfad$,datei$)
  1150.   LOCAL z
  1151.   REM
  1152.   REM Zerlegt einen hierarchischen Dateinamen in seine Bestandteile
  1153.   REM (Zugriffspfad und Dateiname)
  1154.   REM
  1155.   REM V1.0 vom 25.12.1990
  1156.   z=RINSTR(file$,"\")
  1157.   pfad$=LEFT$(file$,z)
  1158.   datei$=MID$(file$,z+1)
  1159. RETURN
  1160. PROCEDURE malloc(which_ram,min,max,VAR speicher,anzahl)
  1161.   ' Achtung: Abweichung bei which_ram vom mxalloc des Betriebssystems!!!
  1162.   ' which_ram:   0 = egal, keine Preferenz
  1163.   '              1 = _nur_ ST-Ram (DMA-Transfer!)
  1164.   ' min, max : mindestens <min>, aber nicht mehr als <max> reservieren!
  1165.   LOCAL st_ram,tt_ram,puffer,nn
  1166.   puffer=MALLOC(16000) ! 16000 Bytes freihalten
  1167.   nn=MIN(
  1168. #MAX(MALLOC(-1),min),max)
  1169.   speicher=MALLOC(nn)
  1170.   IF speicher=0
  1171.     anzahl=0
  1172.   ELSE
  1173.     anzahl=nn
  1174.   ENDIF
  1175.   VOID MFREE(puffer)
  1176. RETURN
  1177. PROCEDURE mshrink(ram,belegt)
  1178.  (74,0,L:ram,L:belegt)
  1179. RETURN
  1180. PROCEDURE mfree(ram)
  1181.   ~MFREE(ram)
  1182. RETURN
  1183. PROCEDURE add_liste(a$)
  1184.   ' hier geht der Punk ab
  1185.   PRINT a$
  1186. RETURN
  1187. lMultiselect (nach R
  1188. ger)                                      GFA-Util
  1189. Autor: Frank R
  1190. ger @ OS2
  1191. Anmerkung: Der FILESELECT-Aufruf sollte nat
  1192. rlich durch was sauberes
  1193. ersetzt werden (
  1194.  ())!
  1195. slct_test
  1196. PROCEDURE slct_test
  1197.   init_slct
  1198.   IF slct_on!
  1199.     ~WIND_UPDATE(3)
  1200.     ' PRINT "
  1201.  vorhanden und eingeschaltet!"
  1202.     DIM dta%(10)
  1203.     dta%=V:dta%(0)
  1204.     slct_comm&=&X1001
  1205.     FILESELECT #"Mehrfache
  1206.     Datei
  1207. bergabe!",CHR$(
  1208.  (25)+65)+":"+DIR$(0)+"\","",back$
  1209.     PRINT "Pfad: ";LEFT$(back$,RINSTR(back$,"\"))
  1210.     gf&=C:slct_get_first%(L:dta%,&X100111)
  1211.     IF gf&=0
  1212.       REPEAT
  1213.         PRINT "Attribute: ";BIN$(BYTE{dta%+21},6)
  1214.         PRINT "L
  1215. nge: ";{dta%+26}
  1216.         PRINT "Name: ";CHAR{dta%+30}
  1217.         gn&=C:slct_get_next%(L:dta%)
  1218.       UNTIL gn&
  1219.     ENDIF
  1220.     ~C:slct_release_dir%()
  1221.     ~WIND_UPDATE(2)
  1222.   ELSE
  1223.     PRINT "
  1224.  nicht vorhanden oder ausgeschaltet!"
  1225.   ENDIF
  1226. RETURN
  1227. PROCEDURE init_slct
  1228.   IF @
  1229. +get_cookie("FSEL",slct_adr%)
  1230.     fsel!=TRUE
  1231.     IF slct_adr%>0 AND EVEN(slct_adr%)
  1232.       IF MKL$(LPEEK(slct_adr%))="SLCT" !LPEEK, falls gesch
  1233. tzter Speicher!
  1234.         slct!=TRUE
  1235.         slct_version%=CARD{slct_adr%+4}
  1236.         multislct!=slct_version%>=&H102
  1237.         ' Im Klartext:
  1238.         slct_version$=STR$(slct_version% DIV 256)+"."
  1239.         slct_version$=slct_version$+RIGHT$("0"+STR$(slct_version% AND
  1240.         255),2)
  1241.         '
  1242.         ' Konfig-Schalter:
  1243.         slct_config%=CARD{slct_adr%+6}
  1244.         '
  1245.         ' 
  1246.   ON/OFF:
  1247.         slct_on!=BTST(slct_config%,0)
  1248.         '
  1249.         ' 
  1250.   ausschalten:
  1251.         ' CARD{slct_adr%+6}=BCLR(CARD{slct_adr%+6},0)
  1252.         ' Einschalten:
  1253.         ' CARD{slct_adr%+6}=BSET(CARD{slct_adr%+6},0)
  1254.         '
  1255.         ' Versteckte Dateien anzeigen:
  1256.         slct_hidden!=BTST(slct_config%,1)
  1257.         '
  1258.         ' Ordner mit 
  1259. +Doppelklick 
  1260. ffnen:
  1261.         slct_dclick!=BTST(slct_config%,2)
  1262.         '
  1263.         ' Kleinbuchstaben benutzen:
  1264.         slct_lower!=BTST(slct_config%,3)
  1265.         '
  1266.         ' Numerisches 
  1267.         slct_numsrt!=BTST(slct_config%,4)
  1268.         '
  1269.         ' Im Zielpfad bleiben:
  1270.         slct_stdest!=BTST(slct_config%,6)
  1271.         '
  1272.         ' TOS-Pfade sichern:
  1273.         slct_pthsav!=BTST(slct_config%,7)
  1274.         '
  1275.         ' Uhrzeit bei Dateien von heute:
  1276.         slct_todaytime!=BTST(slct_config%,8)
  1277.         '
  1278.         ' Sortiermodus (s. Doku):
  1279.         slct_sort&=INT{slct_adr%+8}
  1280.         '
  1281.         ' Anzahl der Extensions:
  1282.         slct_num_ext&=INT{slct_adr%+10}
  1283.         '
  1284.         ' Zeiger auf ein Zeigerfeld (Extensions):
  1285.         slct_ext%={slct_adr%+12}
  1286.         '
  1287.         ' Anzahl Pfade:
  1288.         slct_num_paths&=INT{slct_adr%+16}
  1289.         '
  1290.         ' Zeiger auf ein Zeigerfeld (Pfade):
  1291.         slct_paths%={slct_adr%+18}
  1292.         '
  1293.         ' Kommunikations-Wort (wichtig f
  1294. r Mehrfachselektion!):
  1295.         ABSOLUTE slct_comm&,slct_adr%+22
  1296.         '
  1297.         ' ABSOLUTE slct_in_count&,slct_adr%+24 !z.Zt. nicht benutzt
  1298.         ' slct_in_ptr%={slct_adr%+26}          !        "
  1299.         '
  1300.         ' Hier schreibst Du die Anzahl der erwarteten Files rein
  1301.         ' und liest am Ende die Anzahl der wirklich 
  1302. bergebenen
  1303.         ' Files aus:
  1304.         ABSOLUTE slct_out_count&,slct_adr%+30
  1305.         '
  1306.         ' Zeiger auf Zeigerfeld bei Mehrfachselektion (mu
  1307.  auf einen von
  1308.         ' Dir reservierten Speicherbereich zeigen):
  1309.         ABSOLUTE slct_out_ptr%,slct_adr%+32
  1310.         '
  1311.         ' 3 Zeiger auf C-Funktionen. Aufruf wahrscheinlich mit C:...
  1312.         ' (Reihenfolge der Parameter evtl. umgekehrt?)
  1313.         '
  1314.         ' Zeiger auf get_first(dta%,attrib&):
  1315.         slct_get_first%={slct_adr%+36}
  1316.         ' Aufruf: rueck%=C:slct_get_first%(),L:dta%,attrib&
  1317.         '
  1318.         ' Zeiger auf get_next(dta%):
  1319.         slct_get_next%={slct_adr%+40}
  1320.         ' Aufruf: rueck%=C:slct_get_next(),L:dta%
  1321.         '
  1322.         ' Zeiger auf release_dir():
  1323.         slct_release_dir%={slct_adr%+44}
  1324.         ' Aufruf: rueck%=C:slct_release_dir%()
  1325.         '
  1326.         ' Setzen der 
  1327. 'Adresse dta% z.B. so:
  1328.         ' DIM dta%(10)  ! 11*4 = 44 Bytes DTA-Puffer
  1329.         ' dta%=V:dta%(0)
  1330.         '
  1331.       ENDIF
  1332.     ENDIF
  1333.   ELSE
  1334.     fsel!=FALSE
  1335.     slct!=FALSE
  1336.   ENDIF
  1337. RETURN
  1338. lEreignisverwaltung                                            GFA-Util
  1339. levnt_multi()                                                  GFA-Util
  1340. Autor: Peter Harder @ NF
  1341. Hier mal einige Standardproceduren, die die Arbeit mit EVNT_MULTI f
  1342. bestimmte Aufgaben etwas vereinfachen. Ich habe sie bei mir einfach
  1343. kurz mal ausgeschnitten, vielleicht sind vor dem Einsetzen in ein
  1344. eigenes Programm noch ein paar kleine Anpassungsarbeiten n
  1345. Verschiedene EVNT-Puffer l
  1346. schen ganz oder teilweise l
  1347. schen
  1348. lAuf Taste oder Mausklick warten (ohne Auswertung)             GFA-Util
  1349. Autor: Peter Harder @ NF
  1350. PROCEDURE evnt_wait
  1351.   LOCAL back&
  1352.   ' Nur auf Taste oder Mausklick warten
  1353.   ' ohne diese auszuwerten
  1354.   ~WIND_UPDATE(3)
  1355.   back&=EVNT_MULTI(&X11,&H101,3,0,0,0,0,0,0,0,0,0,0,0,0,0)
  1356.   IF BTST(back&,1)=TRUE  ! Maustaste gedr
  1357.     REPEAT
  1358.     UNTIL @
  1359. &mousek=0
  1360.     @
  1361. *clr_button
  1362.   ENDIF
  1363.   ~WIND_UPDATE(2)
  1364. RETURN
  1365. lAuf Taste warten (mit Auswertung)                             GFA-Util
  1366. Autor: Peter Harder @ NF
  1367. PROCEDURE evnt_tast(VAR m_x&,m_y&,m_k&,ascii&,scan&,
  1368. (w_tasten&)
  1369.   ~WIND_UPDATE(3)  ! kann hier je nach Einsatzart auch raus
  1370. 2' #UMBRUCH ANFANG!
  1371.   back&=EVNT_MULTI(&X11,&H101,3,0,0,0,0,0,0,0,0,0,0,0,0,0,
  1372.   m_x&,m_y&,m_k&,
  1373. (w_tasten&,tast&,clicks%)
  1374. 0' #UMBRUCH ENDE!
  1375. ,mouse_offset(m_x&,m_y&)
  1376.   IF BTST(back&,0)  ! Taste gedr
  1377.     m_k&=0
  1378.     ascii&=BYTE{V:tast&+1}
  1379.     scan&=BYTE{V:tast&}
  1380.     @
  1381. (w_tasten(w_tasten&,alternate!,shift!,control!) ! VAR 3
  1382.     '
  1383.   ELSE
  1384.     ascii&=0
  1385.     scan&=0
  1386. (w_tasten&=
  1387. $BIOS(11,-1)
  1388.     @
  1389. (w_tasten(w_tasten&,alternate!,shift!,control!) ! VAR 3
  1390.   ENDIF
  1391.   ~WIND_UPDATE(2)  ! evtl.raus?
  1392. RETURN
  1393. lTastenstatus ermitteln                                        GFA-Util
  1394. Autor: Peter Harder @ NF
  1395. PROCEDURE w_tasten(w_tasten&,VAR alternate!,shift!,control!)
  1396.   IF BTST(w_tasten&,0)=TRUE OR BTST(w_tasten&,1)=TRUE
  1397.     shift!=TRUE
  1398.   ELSE
  1399.     shift!=FALSE
  1400.   ENDIF
  1401.   control!=BTST(w_tasten&,2)
  1402.   alternate!=BTST(w_tasten&,3)
  1403. RETURN
  1404. lAuf Tastendruck achten (ohne Auswertung)                      GFA-Util
  1405. Autor: Peter Harder @ NF
  1406. Wird h
  1407. ufig ben
  1408. tigt, um eine l
  1409. ngerdauernde Operation durch eine
  1410. Tastendruckabfrage zu beenden. Trotz EVNT_MULTI relativ schnell, da
  1411. wegen der Dummy-Taste nicht auf den Timer gewartet werden mu
  1412. , falls
  1413. kein Tastendruck erfolgt war.
  1414. Beispiel:
  1415.  IF @keylook>0
  1416.    abbruch!=true
  1417.  ENDIF
  1418. FUNCTION keylook
  1419.   $F%
  1420.   LOCAL back&,tast&,v&,v%
  1421.   ~WIND_UPDATE(3)
  1422.   KEYPRESS 255
  1423. 2' #UMBRUCH ANFANG!
  1424.   back&=EVNT_MULTI(&X100001,0,0,0,0,0,0,0,0,0,0,0,0,
  1425.   0,0,5,v&,v&,v&,v&,tast&,v%)
  1426. 0' #UMBRUCH ENDE!
  1427.   ~WIND_UPDATE(2)
  1428.   IF tast&=255 OR back&=32  ! Timer oder Dummytaste?
  1429.     RETURN 0      ! Es ist keine Taste gedr
  1430. ckt worden
  1431.   ELSE
  1432.     @
  1433. *clr_keybuf(TRUE)
  1434.     RETURN tast&  ! Tastaturcode zur
  1435.   ENDIF
  1436. ENDFUNC
  1437. lGEM-
  1438.                                      GFA-Util
  1439. Autor: Peter Harder @ NF
  1440. PROCEDURE clr_keybuf(anz&)
  1441.   ' anz&=TRUE (-1) ==> komplett l
  1442. schen
  1443.   ' anz&=FALSE (0) ==> nicht l
  1444. schen
  1445.   ' anz&>0 ==> Anzahl Tastendr
  1446. cke l
  1447. schen
  1448.   LOCAL back&,zaehler&
  1449.   ~WIND_UPDATE(3)
  1450.   IF anz&<>0
  1451.     REPEAT                      !l
  1452. sche 
  1453. #GEM Tastaturpuffer
  1454.       INC zaehler&
  1455.       back&=EVNT_MULTI(&X100001,0,0,0,0,0,0,0,0,0,0,0,0,0,0,5)
  1456.     UNTIL back&=32 OR zaehler&=anz&
  1457.   ENDIF
  1458.   ~WIND_UPDATE(2)
  1459. RETURN
  1460. lMessagebuffer l
  1461. schen                                         GFA-Util
  1462. Autor: Peter Harder @ NF
  1463. PROCEDURE clr_message
  1464.   ' Ereignis l
  1465. schen
  1466.   ~WIND_UPDATE(3)
  1467.   ~EVNT_MULTI(&X110000,&H101,3,0,0,0,0,0,0,0,0,0,0,0,0,5)
  1468.   ~WIND_UPDATE(2)
  1469. RETURN
  1470. lMaustastenklick l
  1471. schen                                       GFA-Util
  1472. Autor: Peter Harder @ NF
  1473. PROCEDURE clr_button
  1474.   ' Maustastenklick l
  1475. schen
  1476.   ~WIND_UPDATE(3)
  1477.   ~EVNT_MULTI(&X100010,&H101,3,0,0,0,0,0,0,0,0,0,0,0,0,5)
  1478.   ~WIND_UPDATE(2)
  1479. RETURN
  1480. lAbfrage der Alternate-Taste                                   GFA-Util
  1481. Autor: Peter Harder @ NF
  1482. Gibt TRUE zur
  1483. ck, falls die Taste Alternate beim Aufrufen der
  1484. Funktion gedr
  1485. ckt war. Wird h
  1486. ufig ben
  1487. tigt, um eine beim
  1488. Programmstart automatisch aufgerufene Funktion zu unterdr
  1489. cken, wie
  1490. z.B. beim Programm ERGO oder CAT.
  1491. Beispiel:
  1492.  IF @alternate_gedrueckt=FALSE
  1493.    @batch_ausf
  1494.  ENDIF
  1495. FUNCTION alternate_gedrueckt
  1496.   $F%
  1497.   LOCAL w_tst&,v&,v%
  1498.   ~WIND_UPDATE(3)
  1499. 2' #UMBRUCH ANFANG!
  1500.   ~EVNT_MULTI(&X100011,&H101,3,0,0,0,0,0,0,0,0,0,
  1501.   0,0,0,0,v&,v&,v&,w_tst&,v&,v%)
  1502. 0' #UMBRUCH ENDE!
  1503.   ~WIND_UPDATE(2)
  1504.   RETURN BTST(w_tst&,3)  !  0 = Alternate nicht gedr
  1505.   '                        -1 = Alternate gedr
  1506. ENDFUNC
  1507. lGEM-Puffer l
  1508. schen                                            GFA-Util
  1509. Autor: 
  1510. 0Gregor Duchalski @ DO
  1511. ' GEM-Puffer l
  1512. schen...
  1513. > PROCEDURE 
  1514. +clr_message                  ! Wait for NO message-event
  1515.   WHILE BTST(EVNT_MULTI(&X110000,0,0,0,0,0,0,0,0,0,0,0,0,0,0,3),4)
  1516.   WEND
  1517. RETURN
  1518. > PROCEDURE clr_key                      ! Wait for NO keyboard-event
  1519.   WHILE BTST(EVNT_MULTI(&X100001,0,0,0,0,0,0,0,0,0,0,0,0,0,0,50),0)
  1520.   WEND
  1521. RETURN
  1522. > PROCEDURE 
  1523. *clr_button                   ! Wait for NO button-event
  1524.   LOCAL a&,mb&
  1525.   REPEAT
  1526.    ~EVNT_MULTI(&X100010,256+1,3,0,0,0,0,0,0,0,0,0,0,0,0,1,a&,a&,mb&,a&,a&,a&)
  1527.   UNTIL mb&=0
  1528.   WHILE BTST(EVNT_MULTI(&X100010,1,1,1,0,0,0,0,0,0,0,0,0,0,0,3),1)
  1529.   WEND
  1530.   WHILE BTST(EVNT_MULTI(&X100010,1,2,2,0,0,0,0,0,0,0,0,0,0,0,3),1)
  1531.   WEND
  1532. RETURN
  1533. l(FORM-)INPUT                                                  GFA-Util
  1534. Autor: Peter Harder @ NF
  1535. Meine INPUT-Routine ist schon etwas 
  1536. lter und nicht mehr auf der H
  1537. der Zeit. So wird die Variable eing$ noch als globale Variable
  1538. verarbeitet. Die Abbruchbedingungen werden ebenfalls global
  1539. ckgegeben (in_key$, scan_ret&, scan&, ascii&, m_k&). Die Variable
  1540. in_key$ ist noch ein uraltes Relikt aus den Zeiten von GFA 2.0 und
  1541. ist mit dem R
  1542. ckgebewert von dem Befehl INKEY$ identisch. Mein Input
  1543. kann auch durch Pfeil auf/ab, Undo und einen Maustastendruck hin
  1544. verlassen werden. Durch den Tiefstrich sieht der Befehl sehr 
  1545. #GEM-
  1546. hnlich aus. Bei mir funktioniert zwar alles gut, f
  1547. r die
  1548. Allgemeinheit m
  1549. ten die Proceduren aber noch 
  1550. berarbeitet und
  1551. kommentiert werden. Ein Beilegen der Routinen halte ich aber f
  1552. wichtig, die gerade das fehlende Input viele Gelegenheits
  1553. programmierer mit wenig Zeit am patchen hindert.
  1554. FUNCTION form_input$(laenge&,string$)
  1555.   form_input!=TRUE
  1556.   eing$=string$
  1557.   ~WIND_UPDATE(3)
  1558.   @gem_input(CRSCOL,CRSLIN,laenge&) ! braucht eing$
  1559.   ~WIND_UPDATE(2)
  1560.   eing$=LEFT$(eing$,len&)
  1561.   form_input!=FALSE
  1562.   RETURN eing$
  1563. ENDFUNC
  1564. FUNCTION input(laenge&,zahl#)
  1565.   eing$=@str$(zahl#)
  1566.   ~WIND_UPDATE(3)
  1567.   @gem_input(CRSCOL,CRSLIN,laenge&) ! braucht eing$
  1568.   ~WIND_UPDATE(2)
  1569.   RETURN VAL(eing$)
  1570. ENDFUNC
  1571. PROCEDURE gem_input(p_x&,p_y&,len_max&)
  1572.   ' eing$ wird als Globale Variable 
  1573. bergeben und zur
  1574. ckgegeben!!!
  1575.   LOCAL c_pos&,raus!,u$
  1576.   u$=STRING$(len_max&,"_")
  1577.   len&=LEN(eing$)
  1578.   c_pos&=len&
  1579.   eing$=eing$+RIGHT$(u$,len_max&-len&)
  1580.   REPEAT
  1581.     @
  1582. %hidem
  1583.     PRINT AT(p_x&,p_y&);eing$;
  1584.     l_x&=(p_x&+c_pos&)*8-8
  1585.     GRAPHMODE 3
  1586.     LINE l_x&,p_y&*16-15,l_x&,p_y&*16+1
  1587.     @
  1588. %showm
  1589.     @
  1590. )evnt_tast(m_x&,m_y&,m_k&,ascii&,scan&,
  1591. (w_tasten&) ! VAR 6
  1592.     @
  1593. %hidem
  1594.     LINE l_x&,p_y&*16-15,l_x&,p_y&*16+1
  1595.     @
  1596. %showm
  1597.     GRAPHMODE 1
  1598.     EXIT IF scan&=97 OR m_k&=2
  1599.     '
  1600.     IF LEN(in_key$)=1
  1601.       '
  1602.       IF ASC(in_key$)=27                 ! ESC
  1603.         eing$=LEFT$(u$,len_max&)
  1604.         len&=0
  1605.         c_pos&=0
  1606.         '
  1607.       ELSE IF ASC(in_key$)=8             ! Backspace
  1608.         IF c_pos&>0
  1609.           eing$=LEFT$(eing$,c_pos&-1)+MID$(eing$,c_pos&+1)+"_"
  1610.           DEC c_pos&
  1611.           DEC len&
  1612.         ENDIF
  1613.         '
  1614.       ELSE IF ASC(in_key$)=127            ! Delete
  1615.         IF c_pos&<len&
  1616.           eing$=LEFT$(eing$,c_pos&)+MID$(eing$,c_pos&+2)+"_"
  1617.           DEC len&
  1618.         ENDIF
  1619.         '
  1620.       ELSE IF ASC(in_key$)=13             ! Return
  1621.         raus!=TRUE
  1622.         '
  1623.       ELSE IF INSTR("0123456789,.-",in_key$) OR form_input!=TRUE
  1624.         IF in_key$=","
  1625.           IF form_input!=FALSE
  1626.             in_key$="."
  1627.           ENDIF
  1628.         ENDIF
  1629.         IF len&<len_max&
  1630.           eing$=LEFT$(eing$,c_pos&)+in_key$+MID$(eing$,c_pos&+1,len_max&-1-c_pos&)
  1631.           INC c_pos&
  1632.           INC len&
  1633.         ELSE
  1634.           OUT 2,7   ! @beep
  1635.         ENDIF
  1636.         '
  1637.       ELSE IF tg_k!=TRUE
  1638.         raus!=TRUE
  1639.       ENDIF
  1640.       '
  1641.     ELSE IF LEN(in_key$)=2
  1642.       IF ASC(RIGHT$(in_key$))=75          ! Pfeil links
  1643.         IF c_pos&>0
  1644.           DEC c_pos&
  1645.         ENDIF
  1646.       ELSE IF ASC(RIGHT$(in_key$))=77     ! Pfeil rechts
  1647.         IF c_pos&<len&
  1648.           INC c_pos&
  1649.         ENDIF
  1650.       ELSE IF ASC(RIGHT$(in_key$))=97     ! Undo
  1651.         raus!=TRUE
  1652.       ELSE IF tg_k!=TRUE
  1653.         raus!=TRUE
  1654.       ENDIF
  1655.     ELSE IF tg_k!=TRUE
  1656.       raus!=TRUE
  1657.     ELSE IF m_k&=2
  1658.       raus!=TRUE
  1659.     ENDIF
  1660.   UNTIL raus!
  1661.   scan_ret&=scan&
  1662.   scan&=0
  1663. RETURN
  1664. lFensterverwaltung                                             GFA-Util
  1665. Hier steht noch nix!
  1666. lFormulare                                                     GFA-Util
  1667. lMODUL Alert                                                   GFA-Util
  1668. Autor: 
  1669. *Ulf Dunkel @ CLP
  1670. Mit diesem Modul lassen sich ALERTs leicht in einer externen Datei
  1671. verwalten. Dadurch kann...
  1672.  der Anwender diese Fehlertexte in Grenzen seinem Geschmack
  1673.      anpassen,
  1674.  der Programmierer die Fehlertexte leichter pflegen,
  1675.  der Programmierer Fehlertexte mit (momentan 2) variablen Texten
  1676.      benutzen.
  1677. Ich schlage vor, zum Programm einen SYS-Ordner anzulegen, in dem sich
  1678. alle vom Programm ben
  1679. tigten Dateien befinden, z.B. PROGRAMM.RSC,
  1680. PROGRAMM.INF, und eben auch PROGRAMM.ALT - die Alerttexte.
  1681. Die ALT-Datei mu
  1682.  ziemlich zu Anfang des Programms geladen werden,
  1683. damit auch Fehlermeldungen, die schon im Initialisierungsteil des
  1684. Programms auftreten k
  1685. nnen, mit @
  1686.  () ausgegeben werden k
  1687. nnen.
  1688. Deshalb sollte die ALT-Datei z.B. auch vor der RSC-Datei geladen
  1689. werden.
  1690. lFormatbeschreibung der ALERT-Strings                          GFA-Util
  1691. #nnn bbb [s][1..30|1..30|1..30|1..30|1..30][1..10|1..10|1..10]
  1692.  #     Zeiger, da
  1693.  diese Zeile g
  1694. ltig ist
  1695.  nnn   Fehler-Nummer, rechtsb
  1696. ndig, max. 3-stellig, mit f
  1697. hrenden
  1698.        Nullen!
  1699.  bbb   Button-Status f
  1700. r drei verschiedene Programmzust
  1701. nde. Momentan
  1702.        benutze ich selbst nur den ersten Status, es ist aber durch
  1703.        diese drei Zahlenwerte leicht m
  1704. glich, auch eine 3-Button-
  1705.        Alertbox je nach Programmkontext mit einem anderen Default-
  1706.        Button zu zeigen.
  1707.        Beispiel: bbb=312
  1708.           - Status 1 = Button 3 ist DEFAULT-Button
  1709.           - Status 2 = Button 1 ist DEFAULT-Button
  1710.           - Status 3 = Button 2 ist DEFAULT-Button
  1711.  s     Symbol f
  1712. r ALERT-Box (0 = Nichts, 1 = Rufzeichen,
  1713.        2 = Fragezeichen, 3 = Stopschild)
  1714.  1..30 Es folgen dann nach 
  1715. #GEM-Norm max. 5 Zeilen 
  1716.  max. 30 Zeichen
  1717.        ALERTBOX-Text.
  1718.  1..10 max. 3 Button-Texte 
  1719.  max. 10 Zeichen. Der l
  1720. ngste Button-Text
  1721.        gibt die Breite der Buttons (und ggf. der Alertbox) vor.
  1722. lALT-Datei laden                                               GFA-Util
  1723. ge einfach die Funktion @
  1724.   im Initialisierungsteil
  1725. des Programmtextes an der entsprechenden Stelle ein. Die ben
  1726. tigten
  1727. Variablen sind ausf
  1728. hrlich in der Funktion beschrieben. Zeilen, die
  1729. nicht mit # beginnen, werden ignoriert.
  1730. lALERT-Meldung ausgeben und auswerten                          GFA-Util
  1731. An der gew
  1732. nschten Programmstelle einfach den Befehl mit der
  1733. nschten Fehlernummer einf
  1734. gen, ggf. mit einem oder den beiden
  1735. variablen Texten. Beispiele (vorab wird die entspr. in der ALT-Datei
  1736. stehende Zeile gezeigt):
  1737. #001 222 [2][Programm|beenden?][Beenden| Abbruch ]
  1738. GOSUB 
  1739.  (1,1,"","")
  1740. #100 111 [0][%s1 Dateien auf|Laufwerk %s2 |l
  1741. schen?][L
  1742. schen| Abbruch ]
  1743. GOSUB 
  1744.  (100,1,STR$(gefundene_dateien&),"A:")
  1745. lALERT-Texte w
  1746. hrend der Programmentwicklung 
  1747. ndern            GFA-Util
  1748. ge die Zeile @
  1749.   als erste Zeile in Dein Programm
  1750. ein und REMme sie. Wenn Du einen Fehlertext 
  1751. ndern willst, entREMme
  1752. diese Zeile und starte Dein Programm. So kannst Du bequem vor dem
  1753. chsten Programmstart einen, mehrere oder alle ALT-Datei-Zeilen
  1754. ndern oder pr
  1755. fen. Die Prozedur ist ausreichend gut dokumentiert,
  1756. kurzes Ausprobieren d
  1757. rfte die Arbeitsweise rasch n
  1758. herbringen.
  1759. llade_programm_alt                                             GFA-Util
  1760. > FUNCTION lade_programm_alt
  1761. ' RETURN: FALSE, wenn zu wenig Speicher oder Datei falsch, sonst TRUE
  1762. ' ======
  1763. ' GLOBAL al_text$()           !Feld f
  1764. r den ben
  1765. tigten ALERT-String
  1766. ' GLOBAL al_but&()            !Feld f
  1767. r 3 verschiedene Button-Codes,
  1768. '                             !siehe Formatbeschreibung des ALERT-Strings
  1769. ' GLOBAL programm_alt$        !Dateiname mit Pfad
  1770. ' GLOBAL pfad_sysdaten$       !Zugriffspfad f
  1771. r SYS-Dateien=SYS-Ordner
  1772. ' GLOBAL prg$                 !Programm-Name ohne Endung
  1773. ' GLOBAL alt$                 !Datei-Endung f
  1774. r Alert-Datei, mit Punkt
  1775. ' GLOBAL sys$                 !Name des SYS-Ordners ohne Pfad
  1776. LOCAL 
  1777.  $                  !Dateiname ohne Pfad
  1778. LOCAL button|                 !R
  1779. ckgabewert der Alertbox(en)
  1780. LOCAL foo%                    !Parameter-Dummy
  1781. LOCAL al_cnt%                 !Anzahl gelesene Zeilen%
  1782. LOCAL al_nr&                  !Nummer des Fehlertextes
  1783. LOCAL i%                      !Laufvariable
  1784.  $=prg$+alt$
  1785. alert_suchen_nochmal:
  1786. IF NOT EXIST(programm_alt$)
  1787.   ' ALERTBOX VOR @alert_in
  1788. 2' #UMBRUCH ANFANG!
  1789.   ALERT 3,
  1790.  $+" nicht gefunden.|Es mu
  1791.  in einem Ordner|namens "+
  1792.   sys$+" sein.",1," 
  1793.   | Ende ",button|
  1794. 0' #UMBRUCH ENDE!
  1795.   SELECT button|
  1796.   CASE 1      !SUCHEN
  1797.     '
  1798. 2' #UMBRUCH ANFANG!
  1799.     @fileselect(FALSE,suche$+
  1800.  $,"*"+alt$,pfad_sysdaten$,
  1801.  $,programm_alt$,foo%)
  1802. 0' #UMBRUCH ENDE!
  1803.     '
  1804.     GOTO alert_suchen_nochmal
  1805.   CASE 2      !ABBRUCH
  1806.     RETURN FALSE              !Unbedingter Programmabbruch
  1807.     ' END     !Ende           !END reicht ggf. aus
  1808.   ENDSELECT
  1809. ENDIF
  1810. al_cnt%=@zeilenzaehler(programm_alt$)
  1811. IF al_cnt%=0
  1812.   RETURN FALSE                !Unbedingter Programmabbruch
  1813. ENDIF
  1814. ~GRAF_MOUSE(busybee&,0)                       !MAUS-Cursor
  1815. ERASE al_text$(),al_but&()                    !Sicher ist sicher...
  1816. DIM al_text$(al_cnt%),al_but&(al_cnt%)        !Lese-Feld und Button_feld
  1817. OPEN "i",#1,programm_alt$                     !Datei 
  1818. ffnen,
  1819. RECALL #1,al_text$(),TRUE,al_cnt%             !einlesen
  1820. CLOSE #1                                      !und wieder zumachen.
  1821. INSERT al_text$(0)=""                         !F
  1822. r OPTION BASE 1 REMmen
  1823. FOR i%=0 TO al_cnt%                           !Alle Zeilen durch
  1824.   IF LEFT$(al_text$(i%))="#"                  !Nur mit "#" Alerttext:
  1825.     al_nr&=VAL(MID$(al_text$(i%),2))          !fo_a_error_number
  1826.     ' ----------------------------------------!
  1827.     al_but&(al_nr&)=VAL(MID$(al_text$(i%),6)) !fo_adefbttn
  1828.     ' ----------------------------------------!
  1829.     al_text$(al_nr&)=TRIM$(MID$(al_text$(i%),10)) !fo_astring
  1830.   ENDIF
  1831. NEXT i%
  1832. RETURN TRUE
  1833. ENDFUNC
  1834. lalert                                                         GFA-Util
  1835. > FUNCTION alert(fehler&,butcode&,al_var_1$,al_var_2$)
  1836. ' RETURN: Nummer des vom User gedr
  1837. ckten Alert-Buttons
  1838. ' ======
  1839. ' EXTERN fehler&      !Nummer des Fehler-Strings
  1840. ' EXTERN butcode&     !Defaultbutton-Status, momentan immer 1, siehe auch
  1841. '                     !Formatbeschreibung des Alert-Strings
  1842. ' EXTERN al_var_1$    !String, der in den Fehlertext ab %s1 eingef
  1843. gt wird.
  1844. ' EXTERN al_var_2$    !String, der in den Fehlertext ab %s2 eingef
  1845. gt wird.
  1846. LOCAL al_var_1&       !Pointer auf 1. variablen Fehlertext
  1847. LOCAL al_var_2&       !Pointer auf 2. variablen Fehlertext
  1848. LOCAL text$
  1849. LOCAL button|         !R
  1850. ckgabewert der Alertbox(en)
  1851. LOCAL var_1$          !Platzhalter f
  1852. r 1. variablen Fehlertext
  1853. LOCAL var_2$          !Platzhalter f
  1854. r 2. variablen Fehlertext
  1855. LOCAL var_lang&       !L
  1856. nge von var_1$/var_2$
  1857. LET var_1$="%s1"
  1858. LET var_1$="%s2"
  1859. LET var_lang&=LEN(var_1$)
  1860. ' al_but&() enth
  1861. lt drei Buttoncodes f
  1862. r den DEFAULT-Button,
  1863. '           wobei durch Aufruf mit butcode& der gew
  1864. nschte gew
  1865. hlt wird.
  1866. al_var_1&=INSTR(al_text$(fehler&),var_1$)
  1867. SELECT al_var_1&
  1868. CASE 0
  1869. 2' #UMBRUCH ANFANG!
  1870.   button|=FORM_ALERT(VAL(MID$(STR$(al_but&(fehler&)),
  1871.   butcode&,1)),al_text$(fehler&))
  1872. 0' #UMBRUCH ENDE!
  1873. DEFAULT
  1874.   al_var_2&=INSTR(al_text$(fehler&),var_2$)
  1875.   SELECT al_var_2&
  1876.   CASE 0
  1877.     text$=LEFT$(al_text$(fehler&),PRED(al_var_1&))
  1878.     text$=text$+al_var_1$+MID$(al_text$(fehler&),al_var_1&+var_lang&)
  1879.     button|=FORM_ALERT(VAL(MID$(STR$(al_but&(fehler&)),butcode&,1)),text$)
  1880.   DEFAULT
  1881.     text$=LEFT$(al_text$(fehler&),PRED(al_var_1&))
  1882.     '
  1883. 2' #UMBRUCH ANFANG!
  1884.     text$=text$+al_var_1$+MID$(al_text$(fehler&),al_var_1&+
  1885.     var_lang&,al_var_2&-al_var_1&-var_lang&)
  1886. 0' #UMBRUCH ENDE!
  1887.     '
  1888.     text$=text$+al_var_2$+MID$(al_text$(fehler&),al_var_2&+var_lang&)
  1889.     button|=FORM_ALERT(VAL(MID$(STR$(al_but&(fehler&)),butcode&,1)),text$)
  1890.   ENDSELECT
  1891. ENDSELECT
  1892. RETURN button|
  1893. ENDFUNC
  1894. lchange_programm_alt                                           GFA-Util
  1895. > PROCEDURE change_programm_alt !-!PP
  1896. ' LOCAL alt$()        !Feld f
  1897. r die Alerttext-Zeilen
  1898. LOCAL datei$          !Dateiname der Alerttexte mit Pfad
  1899. LOCAL i%              !Laufvariable
  1900. LOCAL j&              !Laufvariable
  1901. LOCAL nnn%            !Anzahl gelesene Zeilen
  1902. LOCAL in$             !Vom Programmierer gew
  1903. nschte Fehlernummer
  1904. LOCAL default&        !Nummer des Default-Alertbuttons
  1905. LOCAL button|         !R
  1906. ckgabewert der Alertbox(en)
  1907. LOCAL loop&           !Anzahl Durchlauf-Schleifen bei Anzeige ALLER Texte
  1908. LOCAL max_alt&        !Max.-Anzahl Fehlertext-Zeilen
  1909. ' *****
  1910. ' Hier kommt der Name DEINER .ALT-Datei hin!
  1911. datei$="K:\MS\SYS\MAILSERV.ALT"
  1912. ' *****
  1913. LET max_alt&=150
  1914. OPEN "i",#1,datei$
  1915. ERASE alt$()                          !Sicher ist sicher
  1916. DIM alt$(PRED(max_alt&))
  1917. RECALL #1,alt$(),max_alt&,nnn%
  1918. CLOSE #1
  1919. LOCATE 1,1                            !Dirty Ausgabe vor Programmstart...
  1920. ALERT 2,"Welche Fehlertexte 
  1921. ndern?",2,"Alle|Einzelne",button|
  1922. SELECT button|
  1923. CASE 1                !Alle
  1924.   ALERT 2,"Anzahl Durchg
  1925. nge|je Fehlertext?",1,"1|2| 3 ",loop&
  1926.   FOR i%=0 TO PRED(max_alt&)          !OPTION BASE 0
  1927.     CLS
  1928.     FOR j&=1 TO loop&
  1929.       LOCATE 1,1
  1930.       FORM INPUT 255 AS alt$(i%)
  1931.       default&=VAL(MID$(alt$(i%),6,1))
  1932.       button|=FORM_ALERT(default&,MID$(alt$(i%),10))
  1933.       MID$(alt$(i%),6,3)=STRING$(3,STR$(button|))
  1934.     NEXT j&
  1935.   NEXT i%
  1936. CASE 2                !einzelne
  1937.     CLS
  1938.     LOCATE 1,1
  1939.     PRINT "Welchen Fehlertext 
  1940. ndern (Abbruch mit [ 0 ] oder[ -1 ]) ";
  1941.     FORM INPUT 3 AS in$
  1942.     i%=VAL(in$)
  1943.     EXIT IF i%<1      !Abbruchbedingung erf
  1944.     DEC i%            !wegen OPTION BASE 0 Fehlernummer DECreasen...
  1945.     LOCATE 1,4
  1946.     FORM INPUT 255 AS alt$(i%)
  1947.     default&=VAL(MID$(alt$(i%),6,1))
  1948.     button|=FORM_ALERT(default&,MID$(alt$(i%),10))
  1949.     MID$(alt$(i%),6,3)=STRING$(3,STR$(button|))
  1950.   LOOP UNTIL i%=-1
  1951. CASE 3
  1952.   in$=""
  1953. ENDSELECT
  1954. IF VAL(in$)=0
  1955.   OPEN "o",#1,datei$
  1956.   STORE #1,alt$(),max_alt&
  1957.   CLOSE #1
  1958. ENDIF
  1959. ERASE alt$()          !Kann wieder weg...
  1960. RETURN
  1961. lALERT-Ersatz als FUNCTION                                     GFA-Util
  1962. Autor: 
  1963. /Michael Wedding @ AC3
  1964. ALERT durch FORM_ALERT ersetzen! N
  1965. tzlich f
  1966. r Programmierer, die sich
  1967. schlecht an die Syntax des FORM_ALERT gew
  1968. hnen k
  1969. nnen. Auch
  1970. interessant zum Anpassen bereits fertiggestellter Programme.
  1971. ' Aufruf: ALERT-Syntax wie bisher, aber letzen Wert nach vorn holen,
  1972. ' dann alles hinter ALERT in Klammern setzen.
  1973. /Michael Wedding, Apr 03 1991
  1974. 2' #UMBRUCH ANFANG!
  1975. DEFFN 
  1976.  (icon|,box$,but|,but$)=
  1977. FORM_ALERT(but|,"["+STR$(icon|)+"]["+box$+"]["+but$+"]")
  1978. 0' #UMBRUCH ENDE!
  1979. lALERT-Ersatz als PROCEDURE                                    GFA-Util
  1980. Autor: 
  1981. /Michael Wedding @ AC3
  1982. ALERT durch FORM_ALERT ersetzen! N
  1983. tzlich f
  1984. r Programmierer, die sich
  1985. schlecht an die Syntax des FORM_ALERT gew
  1986. hnen k
  1987. nnen. Auch
  1988. interessant zum Anpassen bereits fertiggestellter Programme.
  1989. ' Aufruf: ALERT-Syntax wie bisher, aber alles hinter ALERT in Klammern setzen.
  1990. /Michael Wedding, Apr 03 1991
  1991. > PROCEDURE 
  1992.  (ic|,boxtxt$,but|,buttext$,VAR back_alert|)
  1993.   back_alert|=FORM_ALERT(but|,"["+STR$(ic|)+"]["+boxtxt$+"]["+buttext$+"]")
  1994. RETURN
  1995. lRSC im INLINE (Rosin'sche Variante)                           GFA-Util
  1996. Autor: 
  1997. ,Reiner Rosin @ WI2
  1998. INLINE rsc1,32000
  1999. INLINE rsc2,1524
  2000. z=rsc2-rsc1
  2001. IF z<>32000 AND z<>32016
  2002.   ALERT 1,"RSC-Error",1,"Abruch",ok
  2003.   EDIT
  2004. ENDIF
  2005. [...]
  2006. PROC rsrc_conv()
  2007. [...]
  2008. r_rs=CARD{ADD(r_ra,&H22)}            ! L
  2009. nge des INLINEs   /* Rosin 12.6.94
  2010. IF r_rs>0
  2011.   IF r_buf!                            ! RSC Daten puffern (nur Interpreter)...
  2012.     DIM rsc_buf|(r_rs)
  2013.     r_pa=ADD({*rsc_buf|()},4)
  2014.     '
  2015.     IF r_rs<32000                            ! /* Rosin 12.6.94
  2016.       BMOVE r_ra,r_pa,r_rs                   ! /* Rosin 12.6.94
  2017.     ELSE                                     ! /* Rosin 12.6.94
  2018.       BMOVE r_ra,r_pa,32000                  ! /* Rosin 12.6.94
  2019.       BMOVE r_ra+32016,r_pa+32000,r_rs-32000 ! /* Rosin 12.6.94
  2020.     ENDIF                                    ! /* Rosin 12.6.94
  2021.     '
  2022.     r_ra=r_pa
  2023.   ENDIF
  2024. [...]
  2025. Im Interpreter mu
  2026.  die RSC sowieso umkopiert werden und im Compilat
  2027. landen die INLINEs direkt hintereinander. Man mu
  2028.  nur Gregors
  2029. FlyDials etwas anpassen, rsrc_conv() kommt an einigen Stellen nicht
  2030. mit Werten >32767 zurecht (zumindest war das in der V4.7 so).
  2031. lRSC im INLINE (Ebsen'sche Variante)                           GFA-Util
  2032. Autor: 
  2033. -Michael Ebsen @ WHV
  2034. eFrage:
  2035. d Gibt es eine M
  2036. glichkeit, INLINEs, die gr
  2037. er als 32750 Bytes
  2038.     sind in GFA-Basic einzubinden (um dann das RSC nicht mehr
  2039.     nachladen zu m
  2040. ssen)?
  2041. eAntwort:
  2042. d Ja gibt es. Im Programmcode muss folgendes stehen :
  2043. ' rsc-speicher
  2044. ' --V9X
  2045. INLINE rsc_inl2%,32000
  2046. INLINE rsc_inl3%,3600
  2047. z%=SUB(rsc_inl3%,rsc_inl2%)
  2048. IF z%<>32000 AND z%<>32014  ! Achtung dieser Abstand kann bei anderen
  2049.   '                           Interpretern als 3.5E oder 3.6 TT anders
  2050.   '                           sein
  2051.   ALERT 1,"RSC-Error",1,"Abbruch",dummy&
  2052.   END
  2053. ENDIF
  2054. ' --V9X
  2055. Dazu geh
  2056. rt eine Routine rsrc_conv, die die RSC-Koordinaten umwandelt
  2057. > FUNCTION rsrc_conv(l.ra%)
  2058. .| Glob. Var.: fint!
  2059. .| Felder    : rsc_buf&()
  2060. .| Aufruf in : rsc_laden-1,
  2061. ' ***************************************************************
  2062. ' rsrc_conv : wandelt RSC koordinaten  und pointer um, die in
  2063. '             INLINE-Befehlen enthalten sind.
  2064. ' INPUT : l.ra% = RSC-INLINE-adresse
  2065. '         f_int! = TRUE > RSC-daten buffern (nur bei INTERPRETER)
  2066. ' ***************************************************************
  2067. LOCAL l.pa%,l.o%,l.t%,l.obj%,l.no%,l.nt%,l.rs%,l.napt%,l.gb%,l.of%,l.ns%
  2068. LOCAL l.ni%,l.adr%,l.i%
  2069. ' l.pa%       pufferadresse
  2070. ' l.o%,l.t%   laufvar
  2071. ' l.obj%      beginn des objekt feldes
  2072. ' l.no%       anzahl OBJECTS
  2073. ' l.nt%       anzahl TREES
  2074. ' l.rs%       laenge RSC-datenbereich
  2075. ' l.napt%     neue TREE-TABLE-adresse
  2076. ' l.gb%       adr. des 
  2077.  -Global-feldes
  2078. ' l.of%       objekt-feld
  2079. ' l.ns%       anzahl der freien strings
  2080. ' l.ni%       anzahl der freien images
  2081. ' l.adr%,l.i% hilfsvar., laufvar.
  2082. l.rs%=CARD{l.ra%+&H22}
  2083. ' pruefen,ob rsc_buf|() nicht schon dimensioniert ist (=> FEHLER + ABBRUCH)
  2084. ' --OEF
  2085. IF fint! AND DIM?(rsc_buf&())>0
  2086.   RETURN FALSE
  2087. ENDIF
  2088. ' --OEF
  2089. ' nur, wenn INLINE nicht leer und rsc-buf|() noch nicht
  2090. ' dimensioniert worden ist
  2091. ' RSC-daten buffern (nur bei INTERPRETER)
  2092. ' --OEF
  2093. IF fint!
  2094.   DIM rsc_buf&((l.rs%/2)+2)               ! RSC-puffer
  2095.   l.pa%=V:rsc_buf&(0)                     ! Puffer-adresse
  2096.   IF l.rs%<=32000                         ! RSC <= 32000
  2097.     BMOVE l.ra%,l.pa%,l.rs%               ! RSC kopieren
  2098.   ELSE                                    ! >32000 dann Beide INLINES
  2099.     '                                       moven
  2100.     BMOVE l.ra%,l.pa%,32000               ! RSC kopieren
  2101.     BMOVE ADD(l.ra%,32014),ADD(l.pa%,32000),SUB(l.rs%,32000)
  2102.   ENDIF
  2103.   l.ra%=l.pa%                             !neue RSC-adresse
  2104. ENDIF
  2105. ' --OEF
  2106. ' neue adresse der TREE-tabelle
  2107. l.napt%=l.ra%+CARD{l.ra%+&H12}
  2108. ' adr. des 
  2109.  -global-feldes~
  2110. l.gb%={GB+4}
  2111.   neue tabellenadresse zuweisen
  2112. {l.gb%+10}=l.napt%
  2113. ' bisheriger start des objekt-feldes
  2114. l.obj%=CARD{l.ra%+2}
  2115. ' neue startadr. des objekt-feldes
  2116. l.of%=l.ra%+l.obj%
  2117. ' anzahl der objekte im file -1
  2118. l.no%=CARD{l.ra%+&H14}-1
  2119. ' anzahl der TREEES im file -1
  2120. l.nt%=CARD{l.ra%+&H16}-1
  2121. FOR l.o%=0 TO l.no%     ! alle objekte
  2122.   ' koordinaten umrechnen'
  2123.   ~RSRC_OBFIX(l.of%,l.o%)
  2124.   SELECT BYTE(OB_TYPE(l.of%,l.o%))
  2125.     '
  2126.     ' zeiger auf struktur mit 3 zeigern -TEDINFO bzw. ICONBLK
  2127.     ' (TEXT,BOXTEXT,FTEXT,FBOXTEXT,ICON)
  2128.     '
  2129.   CASE &H15,&H16,&H1D,&H1E,&H1F
  2130.     IF EVEN(OB_SPEC(l.of%,l.o%))
  2131.       OB_SPEC(l.of%,l.o%)=OB_SPEC(l.of%,l.o%)+l.ra%
  2132.       {OB_SPEC(l.of%,l.o%)}={OB_SPEC(l.of%,l.o%)}+l.ra%
  2133.       {OB_SPEC(l.of%,l.o%)+4}={OB_SPEC(l.of%,l.o%)+4}+l.ra%
  2134.       {OB_SPEC(l.of%,l.o%)+8}={OB_SPEC(l.of%,l.o%)+8}+l.ra%
  2135.     ENDIF
  2136.     '
  2137.     ' zeiger auf struktur mit 2 zeigern - APPLBLK
  2138.     ' (PROGDEF)
  2139.     '
  2140.   CASE &H18
  2141.     OB_SPEC(l.of%,l.o%)=OB_SPEC(l.of%,l.o%)+l.ra%
  2142.     {OB_SPEC(l.of%,l.o%)}={OB_SPEC(l.of%,l.o%)}+l.ra%
  2143.     {OB_SPEC(l.of%,l.o%)+4}={OB_SPEC(l.of%,l.o%)+4}+l.ra%
  2144.     '
  2145.     ' zeiger auf struktur mit 1 zeiger - BITBLK
  2146.     ' (IMAGE)
  2147.     '
  2148.   CASE &H17
  2149.     OB_SPEC(l.of%,l.o%)=OB_SPEC(l.of%,l.o%)+l.ra%
  2150.     {OB_SPEC(l.of%,l.o%)}={OB_SPEC(l.of%,l.o%)}+l.ra%
  2151.     '
  2152.     ' zeiger auf datenstruktur - C-text
  2153.     ' (BUTTON,STRING.TITLE)
  2154.     '
  2155.   CASE &H1A,&H1C,&H20
  2156.     OB_SPEC(l.of%,l.o%)=OB_SPEC(l.of%,l.o%)+l.ra%
  2157.     '
  2158.   ENDSELECT
  2159. NEXT l.o%
  2160. ' ap_tree-tabelle aktualisieren
  2161. FOR l.t%=0 TO l.nt%     ! alle baeume
  2162.   {l.napt%+(4*l.t%)}={l.napt%+(4*l.t%)}+l.ra%
  2163. NEXT l.t%
  2164. ' FREE_STRINGS-tabelle aktualisieren
  2165. l.ns%=CARD{l.ra%+&H1E}-1
  2166. IF l.ns%>-1
  2167.   l.adr%=l.ra%+CARD{l.ra%+&HA}
  2168.   FOR l.i%=0 TO l.ns%
  2169.     {l.adr%+(4*l.i%)}={l.adr%+(4*l.i%)}+l.ra%
  2170.     '
  2171.   NEXT l.i%
  2172. ENDIF
  2173. ' FREE_IMAGEs-tabelle aktualisieren
  2174. l.ni%=CARD{l.ra%+&H20}-1
  2175. IF l.ni%>-1
  2176.   l.adr%=l.ra%+CARD{l.ra%+&H10}
  2177.   FOR l.i%=0 TO l.ni%
  2178.     {l.adr%+(4*l.i%)}={l.adr%+(4*l.i%)}+l.ra%
  2179.     '
  2180.     ' pointer in BITBLK relozieren
  2181.     '
  2182.     {{l.adr%+(4*l.i%)}}={{l.adr%+(4*l.i%)}}+l.ra%
  2183.     '
  2184.   NEXT l.i%
  2185. ENDIF
  2186. RETURN TRUE
  2187. ENDFUNC
  2188. lGrafikfunktionen                                              GFA-Util
  2189. lMODUL Mouse                                                   GFA-Util
  2190. Autor: 
  2191. *Ulf Dunkel @ CLP
  2192. ' MODUL MOUSE
  2193. ' ===========
  2194. PROCEDURE 
  2195. %mouse(type&,adr%)
  2196.   ' INTENT: Mauscursor-Form 
  2197. ndern (mit Ber
  2198. cksichtigung von Multitasking-
  2199.   ' GLOBAL multi_aes!
  2200.   ' EXTERN type&
  2201.   ' EXTERN adr%
  2202.   IF multi_aes!
  2203.     SELECT type&
  2204.     CASE arrow&                         !Maus wieder normal
  2205.       ~GRAF_MOUSE(type&,adr%)
  2206.     DEFAULT
  2207.       ~GRAF_MOUSE(&H8000 OR type&,adr%) !Mausform puffern und 
  2208. ndern
  2209.     ENDSELECT
  2210.   ELSE
  2211.     ~GRAF_MOUSE(type&,adr%)
  2212.   ENDIF
  2213. RETURN
  2214. PROCEDURE 
  2215. &mousek(val&)
  2216.   ' INTENT: wartet auf bestimmten Mausbutton-Status
  2217.   LOCAL mk_state&
  2218.   LOCAL foo&
  2219.     ~GRAF_MKSTATE(foo&,foo&,mk_state&,foo&)
  2220.   LOOP UNTIL mk_state&=val&
  2221. RETURN
  2222. FUNCTION mousebutton
  2223.   $F%
  2224.   ' INTENT: pr
  2225. ft aktuellen Mausbutton-Status
  2226.   ' RETURN: aktueller Mausbutton-Status
  2227.   LOCAL mk_state&
  2228.   ~GRAF_MKSTATE(foo&,foo&,mk_state&,foo&)
  2229.   RETURN mk_state&
  2230. ENDFUNC
  2231. PROCEDURE mouse_userdef
  2232.   ' GLOBAL alle hier genannten Variablen
  2233.   INLINE disk%,74
  2234.   INLINE drucker%,74
  2235.   INLINE kaffee%,74
  2236.   INLINE 
  2237.   INLINE mem1%,74
  2238.   INLINE mem2%,74
  2239.   INLINE mem3%,74
  2240.   INLINE mem4%,74
  2241.   INLINE uhr1%,74
  2242.   INLINE uhr2%,74
  2243.   INLINE uhr3%,74
  2244.   INLINE uhr4%,74
  2245.   INLINE uhr5%,74
  2246.   INLINE uhr6%,74
  2247.   INLINE uhr7%,74
  2248.   INLINE uhr8%,74
  2249.   INLINE tast%,74
  2250.   @mouse_defmouse(diskbild&,diskmask&,7,7,disk%)
  2251.   @mouse_defmouse(drucbild&,drucmask&,7,7,drucker%)
  2252.   @mouse_defmouse(kaffbild&,kaffmask&,7,7,kaffee%)
  2253.   @mouse_defmouse(sandbild&,sandmask&,7,7,
  2254.   @mouse_defmouse(mem1bild&,mem1mask&,7,7,mem1%)
  2255.   @mouse_defmouse(mem2bild&,mem1mask&,7,7,mem2%)
  2256.   @mouse_defmouse(mem3bild&,mem1mask&,7,7,mem3%)
  2257.   @mouse_defmouse(mem4bild&,mem1mask&,7,7,mem4%)
  2258.   @mouse_defmouse(uhr1bild&,uhrmaske&,7,7,uhr1%)
  2259.   @mouse_defmouse(uhr2bild&,uhrmaske&,7,7,uhr2%)
  2260.   @mouse_defmouse(uhr3bild&,uhrmaske&,7,7,uhr3%)
  2261.   @mouse_defmouse(uhr4bild&,uhrmaske&,7,7,uhr4%)
  2262.   @mouse_defmouse(uhr5bild&,uhrmaske&,7,7,uhr5%)
  2263.   @mouse_defmouse(uhr6bild&,uhrmaske&,7,7,uhr6%)
  2264.   @mouse_defmouse(uhr7bild&,uhrmaske&,7,7,uhr7%)
  2265.   @mouse_defmouse(uhr8bild&,uhrmaske&,7,7,uhr8%)
  2266.   @mouse_defmouse(tastbild&,tastmask&,7,7,tast%)
  2267. RETURN
  2268. PROCEDURE mouse_defmouse(bild&,mask&,xcoord&,ycoord&,adr%)
  2269.   ' GLOBAL CONST r_frimg&       !OBJ-# f
  2270. r freie Bit-Images
  2271.   ' EXTERN bild&                !Mauscursor-Daten-Objektnummer
  2272.   ' EXTERN mask&                !Maskendaten-Objektnummer
  2273.   ' EXTERN xcoord&              !X-Koordinate des Aktionspunktes (HotSpot)
  2274.   ' EXTERN ycoord&              !Y-Koordinate des Aktionspunktes (HotSpot)
  2275.   ' EXTERN adr%                 !Pointer auf INLINE-String
  2276.   LOCAL i|                      !Z
  2277. hlvariable
  2278.   LOCAL user_def$               !Pufferstring f
  2279. r Mauscursor-Daten
  2280.   LOCAL bild_adr%               !
  2281. 'Adresse des FREE_IMAGE (Mauscursor)
  2282.   LOCAL mask_adr%               !
  2283. 'Adresse des FREE IMAGE (Mausmaske)
  2284.   LOCAL bild_pointer%           !Zeiger auf Image-Daten f
  2285. r Cursorform
  2286.   LOCAL mask_pointer%           !Zeiger auf Image-Daten f
  2287. r Maskenform
  2288.   user_def$=MKI$(xcoord&)+MKI$(ycoord&)+MKI$(1)+MKI$(0)+MKI$(1)
  2289.   '         XKoordinate   YKoordinate   Farbnr. Mskfarb CurFarb
  2290.   ~RSRC_GADDR(r_frimg&,bild&,bild_adr%)
  2291.   ~RSRC_GADDR(r_frimg&,mask&,mask_adr%)
  2292.   bild_pointer%={{bild_adr%}}
  2293.   mask_pointer%={{mask_adr%}}
  2294.   FOR i|=0 TO 15
  2295.     user_def$=user_def$+MKI$(CARD{mask_pointer%+SHL|(i|,1)})
  2296.   NEXT i|
  2297.   FOR i|=0 TO 15
  2298.     user_def$=user_def$+MKI$(CARD{bild_pointer%+SHL|(i|,1)})
  2299.   NEXT i|
  2300.   CHAR{adr%}=user_def$          !String an INLINE-
  2301. 'Adresse legen
  2302. RETURN
  2303. PROCEDURE mouse_show
  2304.   ' Im Original-GFABASIC-Version nur Dummy, da es selbst die
  2305.   ' Maus aus und einschaltet, im GFAPASIC ist es wichtig!
  2306.   ~GRAF_MOUSE(m_on&,0)
  2307. RETURN
  2308. PROCEDURE mouse_hide
  2309.   ' Im Original-GFABASIC-Version nur Dummy, da es selbst die
  2310.   ' Maus aus und einschaltet, im GFAPASIC ist es wichtig!
  2311.   ~GRAF_MOUSE(m_off&,0)
  2312. RETURN
  2313. FUNCTION mouse_mem(maus%,type&)
  2314.   $F%
  2315.   ' INTENT: zeigt laufende Uhr oder Flipscheibe
  2316.   ' RETURN: aktueller Z
  2317. hlwert
  2318.   ' EXTERN maus%        !Counter
  2319.   ' EXTERN type&        !0=Uhr, 1=Flipscheibe, 2=Kreuzcursor
  2320.   INC maus%
  2321.   SELECT type&
  2322.   CASE 0
  2323.     SELECT maus%
  2324.     CASE 1000
  2325.       @
  2326. %mouse(user_def&,uhr8%)
  2327.       RETURN 0
  2328.     CASE 875
  2329.       @
  2330. %mouse(user_def&,uhr7%)
  2331.     CASE 750
  2332.       @
  2333. %mouse(user_def&,uhr6%)
  2334.     CASE 625
  2335.       @
  2336. %mouse(user_def&,uhr5%)
  2337.     CASE 500
  2338.       @
  2339. %mouse(user_def&,uhr4%)
  2340.     CASE 375
  2341.       @
  2342. %mouse(user_def&,uhr3%)
  2343.     CASE 250
  2344.       @
  2345. %mouse(user_def&,uhr2%)
  2346.     CASE 125
  2347.       @
  2348. %mouse(user_def&,uhr1%)
  2349.     ENDSELECT
  2350.   CASE 1
  2351.     SELECT maus%
  2352.     CASE 500
  2353.       @
  2354. %mouse(user_def&,mem4%)
  2355.       RETURN 0
  2356.     CASE 375
  2357.       @
  2358. %mouse(user_def&,mem3%)
  2359.     CASE 250
  2360.       @
  2361. %mouse(user_def&,mem2%)
  2362.     CASE 125
  2363.       @
  2364. %mouse(user_def&,mem1%)
  2365.     ENDSELECT
  2366.   CASE 2
  2367.     SELECT maus%
  2368.     CASE 20
  2369.       @
  2370. %mouse(thick_cross&,0)
  2371.       RETURN 0
  2372.     CASE 10
  2373.       @
  2374. %mouse(outln_cross&,0)
  2375.     ENDSELECT
  2376.   ENDSELECT
  2377.   RETURN maus%
  2378. ENDFUNC
  2379. PROCEDURE mouse_clear
  2380. &mousek(0)
  2381. RETURN
  2382. lDefmouse                                                      GFA-Util
  2383. Autor: 
  2384.   @ AC3
  2385. > PROCEDURE defmouse(ms|)
  2386. bergebener Wert darf zwischen 0 und 7 sein:
  2387.   ' Entspricht DEFMOUSE ms|
  2388.   ' 0 = Pfeil
  2389.   ' 1 = X-Klammer (Text-Cursor)
  2390.   ' 2 = Biene
  2391.   ' 3 = Zeigende Hand
  2392.   ' 4 = Offene Hand
  2393.   ' 5 = Fadenkreuz fein
  2394.   ' 6 =      "     grob
  2395.   ' 7 =      "     umrandet
  2396.   IF ms|>-1 AND ms|<8
  2397.     ~GRAF_MOUSE(ms|,0)
  2398.   ELSE
  2399.     ~GRAF_MOUSE(0,0)
  2400.   ENDIF
  2401. RETURN
  2402. lBusymouse                                                     GFA-Util
  2403. Autor: 
  2404. ,Ulli Gruszka @ DO, 
  2405.   @ AC3 (weitere Animationen
  2406. eingef
  2407. tigt wird: 
  2408.  3.33.1 
  2409.  3.33.2 
  2410. lEinbindung und Aufruf in eigenen Programmen                   GFA-Util
  2411. Wer's einfach haben will, schlachtet BUSY.RSC hemmungslos aus, indem
  2412. er die IBOXen mit den Icons an eine beliebige Stelle seiner Resource
  2413. kopiert.
  2414. Der eigentliche Aufruf findet durch busy(Tree,Obj) statt. Schleifen
  2415. bieten sich f
  2416. r einen Aufruf an, wobei bedacht werden sollte, da
  2417. auch GFA-Basic recht schnell sein kann. :-) Also: Nicht jede Schleife
  2418. eignet sich, es sollte schon einiges darin passieren. Anderenfalls
  2419. uft die Maus Amok!
  2420. Nach dem Ende einer Animation mu
  2421.  der Mauszeiger nat
  2422. rlich noch mit
  2423. @defmouse(0) zur
  2424. ckgesetzt werden...
  2425. lEigene Animationen erstellen                                  GFA-Util
  2426. Sollten meine Sch
  2427. pfungen nicht gefallen (unwahrscheinlich ;-), mu
  2428. r jeden Einzelschritt einer Sequenz ein 16X16 Pixel gro
  2429. es Icon
  2430. erstellt werden. Alle Icons einer Sequenz m
  2431. ssen sich innerhalb eines
  2432. Elternobjektes befinden und entsprechend der gew
  2433. nschten Bildfolge
  2434. sortiert sein.
  2435. Bei jedem ersten Icon einer Sequenz muss das Flag SELECTED gesetzt
  2436. werden, anhand dessen @busy das derzeit aktuelle Icon erkennt. Der
  2437. Selected-State wird demnach von @busy() "umgesetzt".
  2438. Den Elternobjekten sollten im RCS Namen zugewiesen werden, damit
  2439. diese sp
  2440. ter der Busy-Routine 
  2441. bergeben werden k
  2442. nnen.
  2443. Die Anzahl der Einzelschritte ist nicht begrenzt, sinnvollerweise ist
  2444. sie jedoch >=1. Befindet sich nur ein Icon im Elternobjekt, wird der
  2445. Mauszeiger halt nur ver
  2446. ndert.
  2447. Neben den Icons d
  2448. rfen sich 
  2449. lkeine
  2450. d weiteren 
  2451.   in den
  2452. Elternobjekten befinden!
  2453. Siehe auch: 
  2454.  -Demo
  2455. lBusymouse Demo                                                GFA-Util
  2456. @do_it
  2457. > PROCEDURE do_it                      ! Alles nur Demo ...
  2458.   IF RSRC_LOAD("busy.rsc")=0
  2459.     ~FORM_ALERT(1,"[3][Keine Resource-Datei!][Abbruch]")
  2460.     END
  2461.   ENDIF
  2462.   @rsc_zuweisungen         ! RSC-Zuweisungen f
  2463. r Busymouse Demo
  2464.   ~RSRC_GADDR(0,form1&,form1%)
  2465.   ~RSRC_GADDR(0,form2&,form2%)
  2466.   ~FORM_CENTER(form2%,d&,d&,d&,d&)
  2467.   ~OBJC_DRAW(form2%,0,8,0,0,0,0)
  2468.   x#=0.1                              ! Nur ein Z
  2469. hler f
  2470. r das Tempo der
  2471.   '                                    Animation
  2472.   ani&=ball&                         ! Die IBOX mit der ersten Sequenz
  2473.   WHILE mks&<3                       ! Schleife bis zum Programmende
  2474.     '
  2475.     @busy(form1%,ani&)               ! *Das ist der Aufruf.* form1% ist
  2476.     '                                ! die 
  2477. 'Adresse des Formulars/Dialogs in dem
  2478.     '                                ! die Animationen abgelegt sind, und ani&
  2479.     '                                ! ist der 
  2480. %Index des Objekts (die IBOX ...)
  2481.     '                                ! in dem die jeweiligen Icons liegen.
  2482.     '
  2483.     ~GRAF_MKSTATE(d&,d&,mks&,state&) ! Maus/Tasten-Status abfragen
  2484.     '
  2485.     LET sanduhr&=78
  2486.     IF ani&=ball& AND state&<>0      ! Sequenz wechseln
  2487.       ani&=disk&
  2488.     ELSE IF ani&=disk& AND state&<>0
  2489.       ani&=pulse&
  2490.     ELSE IF ani&=pulse& AND state&<>0
  2491.       ani&=arrow&
  2492.     ELSE IF ani&=arrow& AND state&<>0
  2493.       ani&=ball2&
  2494.     ELSE IF ani&=ball2& AND state&<>0
  2495.       ani&=clock&
  2496.     ELSE IF ani&=clock& AND state&<>0
  2497.       ani&=tasse&
  2498.     ELSE IF ani&=tasse& AND state&<>0
  2499.       ani&=wuerfel&
  2500.     ELSE IF ani&=wuerfel& AND state&<>0
  2501.       ani&=rechner&
  2502.     ELSE IF ani&=rechner& AND state&<>0
  2503.       ani&=papier&
  2504.     ELSE IF ani&=papier& AND state&<>0
  2505.       ani&=sanduhr&
  2506.     ELSE IF ani&=sanduhr& AND state&<>0
  2507.       ani&=ball&
  2508.     ENDIF
  2509.     IF mks&=1 AND x#<0.5              ! Tempo ver
  2510. ndern
  2511.       ADD x#,0.01
  2512.     ELSE IF mks&=2 AND x#>0.01
  2513.       SUB x#,0.02
  2514.     ENDIF
  2515.     DELAY x#                          ! Warten ...
  2516.   WEND
  2517.   @defmouse(0)
  2518.   ~RSRC_FREE()
  2519.   END
  2520. RETURN
  2521. > PROCEDURE rsc_zuweisungen     ! RSC-Zuweisungen f
  2522. r Busymouse Demo
  2523.   '                             --WEG
  2524.   '                             ++SYM
  2525.   LET form1&=0
  2526.   LET ball&=2
  2527.   LET disk&=7
  2528.   LET pulse&=10
  2529.   LET arrow&=23
  2530.   LET ball2&=25
  2531.   LET clock&=35
  2532.   LET tasse&=48
  2533.   LET wuerfel&=51
  2534.   LET rechner&=58
  2535.   LET papier&=63
  2536.   LET sanduhr&=78
  2537.   ' --------------------------
  2538.   LET form2&=1
  2539.   '                             ++SYM
  2540.   '                             --WEG
  2541. RETURN
  2542. > PROCEDURE busy(tree%,obj&)           ! Der Animateur ...
  2543.   LOCAL first&,last&,i%,adr%,hd$
  2544.   first&=OB_HEAD(tree%,obj&)                          ! erstes Icon
  2545.   last&=OB_TAIL(tree%,obj&)                           ! letztes Icon
  2546.   i%=first&
  2547.   ' Hier werden die Mausdaten zusammengesetzt und in ein INLINE gesteckt.
  2548.   INLINE adr%,74
  2549.   hd$=MKI$(1)+MKI$(1)+MKI$(1)+MKI$(0)+MKI$(1)         ! Header anlegen und ab
  2550.   BMOVE V:hd$,adr%,10                                 ! in die Struktur damit
  2551.   WHILE i%<=last&
  2552.     IF BTST(OB_STATE(tree%,i%),0)                     ! Wenn SELECTED, dann
  2553.       BMOVE LONG{OB_SPEC(tree%,i%)},adr%+10,32        ! Icondaten kopieren,
  2554.       BMOVE LONG{OB_SPEC(tree%,i%)+4},adr%+42,32      ! Iconmaske kopieren
  2555.       OB_STATE(tree%,i%)=BCLR(OB_STATE(tree%,i%),0)   ! und Icon deSELECTED.
  2556.       '
  2557.       INC i%                                          ! N
  2558. chstes Icon:
  2559.       IF i%<=last&                                    ! Wenn noch nicht am
  2560.         '                                             ! am Ende angekommen,
  2561.         OB_STATE(tree%,i%)=BSET(OB_STATE(tree%,i%),0) ! dann SELECTED,
  2562.       ELSE                                            ! sonst das erste Icon
  2563.         '                                               auf SELECTED setzen.
  2564.         OB_STATE(tree%,first&)=BSET(OB_STATE(tree%,first&),0)
  2565.       ENDIF
  2566.       i%=last&                                        ! = Schleifenende
  2567.       '
  2568.     ENDIF                                             ! Anderenfalls weiter-
  2569.     INC i%                                            ! suchen ...
  2570.     '
  2571.   WEND
  2572.   IF multi_aes!                                       ! Mauszeiger setzen
  2573.     ~GRAF_MOUSE(&H8000 OR 255,adr%)                   ! Multitasking
  2574.   ELSE
  2575.     ~GRAF_MOUSE(255,adr%)                             ! Plain-TOS
  2576.   ENDIF
  2577. RETURN
  2578. lEinfache 
  2579.                                              GFA-Util
  2580. Autor: 
  2581.   @ AC3
  2582. Diese "Animation" ist auch in 
  2583.   vorhanden.
  2584. ' MODUL-BUSYMOUSE 1.0
  2585. ' (C) 05.08.1993 von 
  2586. ' FUNKTION: BUSYMOUSE als rotierender Ball darstellen
  2587. INLINE 
  2588.  ,592
  2589. m_adr%=busymaus%
  2590. > PROCEDURE busymouse
  2591.   ' ADD(m_busy%,xxx)  xxx= INLINE-L
  2592. nge minus 74!
  2593.   ' INLINE-L
  2594. nge / 74 = Anzahl der einzel-Bilder
  2595.   IF m_adr%=ADD(busymaus%,1628)
  2596.     m_adr%=busymaus%
  2597.   ELSE
  2598.     ADD m_adr%,74
  2599.   ENDIF
  2600.   ~GRAF_MOUSE(255,m_adr%)
  2601. RETURN
  2602. lEinfache Sanduhr                                              GFA-Util
  2603. Autor: 
  2604.   @ AC3
  2605. Diese "Animation" ist auch in 
  2606.   vorhanden.
  2607. ' MODUL-SANDUHR 1.0
  2608. ' (C) 19.07.1993 von 
  2609. ' FUNKTION: SANDUHR darstellen
  2610. INLINE 
  2611.  ,1702
  2612. m_adr%=
  2613. > PROCEDURE sanduhr
  2614.   ' ADD(m_busy%,xxx)  xxx= INLINE-L
  2615. nge minus 74!
  2616.   ' INLINE-L
  2617. nge / 74 = Anzahl der einzel-Bilder
  2618.   IF m_adr%=ADD(
  2619.  ,1628)
  2620.     m_adr%=
  2621.   ELSE
  2622.     ADD m_adr%,74
  2623.   ENDIF
  2624.   ~GRAF_MOUSE(255,m_adr%)
  2625. RETURN
  2626. lMausposition ermitteln                                        GFA-Util
  2627. Autor: Peter Harder @ NF
  2628. PROCEDURE mouse(VAR mx&,my&,mk&)
  2629.   LOCAL void&
  2630.   ~WIND_UPDATE(3)
  2631.   ~GRAF_MKSTATE(mx&,my&,mk&,void&)
  2632.   ~WIND_UPDATE(2)
  2633.   SUB mx&,WORD{WINDTAB+64}
  2634.   SUB my&,WORD{WINDTAB+66}
  2635. RETURN
  2636. lMaustastenstatus ermitteln                                    GFA-Util
  2637. Autor: Peter Harder @ NF
  2638. FUNCTION mousek
  2639.   $F%
  2640.   LOCAL mk&,void&
  2641.   ~WIND_UPDATE(3)
  2642.   ~GRAF_MKSTATE(void&,void&,mk&,void&)
  2643.   ~WIND_UPDATE(2)
  2644.   RETURN mk&
  2645. ENDFUNC
  2646. lX-Position ermitteln                                          GFA-Util
  2647. Autor: Peter Harder @ NF
  2648. FUNCTION mousex
  2649.   $F%
  2650.   LOCAL mx&,void&
  2651.   ~WIND_UPDATE(3)
  2652.   ~GRAF_MKSTATE(mx&,void&,void&,void&)
  2653.   ~WIND_UPDATE(2)
  2654.   SUB mx&,WORD{WINDTAB+64}
  2655.   RETURN mx&
  2656. ENDFUNC
  2657. lY-Position ermitteln                                          GFA-Util
  2658. Autor: Peter Harder @ NF
  2659. FUNCTION mousey
  2660.   $F%
  2661.   LOCAL my&,void&
  2662.   ~WIND_UPDATE(3)
  2663.   ~GRAF_MKSTATE(void&,my&,void&,void&)
  2664.   ~WIND_UPDATE(2)
  2665.   SUB my&,WORD{WINDTAB+66}
  2666.   RETURN my&
  2667. ENDFUNC
  2668. lMauszeiger verstecken                                         GFA-Util
  2669. Autor: Peter Harder @ NF
  2670. PROCEDURE hidem
  2671.   IF maus_aus&=0
  2672.     ~GRAF_MOUSE(256,0)
  2673.     ~WIND_UPDATE(1)
  2674.   ENDIF
  2675.   INC maus_aus&
  2676. RETURN
  2677. lMauszeiger aufdecken                                          GFA-Util
  2678. Autor: Peter Harder @ NF
  2679. PROCEDURE showm
  2680.   IF maus_aus&=1
  2681.     ~WIND_UPDATE(0)
  2682.     ~GRAF_MOUSE(257,0)
  2683.   ENDIF
  2684.   DEC maus_aus&
  2685.   IF maus_aus&<0
  2686.     maus_aus&=0
  2687.   ENDIF
  2688. RETURN
  2689. lSETMOUSE-Ersatz                                               GFA-Util
  2690. Autor: Peter Harder @ NF
  2691. PROCEDURE setmouse(x&,y&)                  ! GEMSYS 14
  2692.   ' Gepostet in der FAQ 9/94 (
  2693. 0Gregor Duchalski)
  2694.   LOCAL a%,a$
  2695.   a%=OR(y&,SHL(x&,16))   !X/Y-Pos. des Mauszeigers
  2696.   a$=MKL$(2)+MKL$(a%)    !Ereignis
  2697.   GINTIN(0)=1            !Anzahl Ereignisse
  2698.   GINTIN(1)=100          !Geschwindigkeit in %
  2699.   ADDRIN(0)=V:a$         !
  2700. 'Adresse der Ereignisse
  2701.   GEMSYS 14              !APPL_TPLAY()
  2702. RETURN
  2703. lMOUSE-Offset                                                  GFA-Util
  2704. Autor: Peter Harder @ NF
  2705. PROCEDURE mouse_offset(VAR x&,y&) SUB x&,WORD{WINDTAB+64} SUB
  2706. y&,WORD{WINDTAB+66} RETURN
  2707. s                                                         GFA-Util
  2708. Hier steht noch nix!
  2709. lObjekte                                                       GFA-Util
  2710. Hier steht noch nix!
  2711. lResourceorganisation                                          GFA-Util
  2712. lMenushortcut ermitteln                                        GFA-Util
  2713. Autor: 
  2714. ,Ulli Gruszka @ DO
  2715. Mal ehrlich: Wer hat noch nicht geflucht, weil er einen Men
  2716. -Tastatur-
  2717.  Shortcut im RCS ge
  2718. ndert hat und seinen Code anschlie
  2719. end einen
  2720. halben Meter tief umgraben mu
  2721. te? Hm? Wenn der Men
  2722. eintrag dann auch
  2723. noch einem anderen Titel untergeschoben wurde ...
  2724. Diese Funktion erledigt nun die Zuordnung von Tastendr
  2725. cken zu
  2726. Eintr
  2727. gen in Men
  2728. umen. Sie kommt aus der Abteilung "Routinen, auf
  2729. die die Welt gewartet hat", Unterabteilung "Einbauen und Vergessen!",
  2730. denn genau wie bei MN_SELECTED des 
  2731.  , werden die Objektnummern des
  2732. Titels und des Eintrages zur
  2733. ckgeliefert. Ihre Benutzung garantiert
  2734. zu jeder Zeit, also auch zur sp
  2735. teren Laufzeit beim Anwender, die
  2736. llig freie Konfiguration der Shortcuts.
  2737. Unterst
  2738. tzt werden alle Tasten in Kombinationen mit CONTROL, SHIFT,
  2739. ALTERNATE, sowie die Funktionstasten F1 - F10. Voraussetzung f
  2740. einen reibungslosen Ablauf ist allerdings, da
  2741.  die nicht offiziell
  2742. dokumentierte Men
  2743. struktur beibehalten wird, da
  2744.  es sich bei den
  2745. eintr
  2746. gen um normale G_STRING-
  2747.   handelt, und da
  2748.  die SCs im
  2749. RCS standardkonform eingetragen werden.
  2750. Siehe FUNCTION 
  2751. lscan_menu()                                                   GFA-Util
  2752. FUNCTION scan_menu(k_state&,key&,menu%,VAR titel&)
  2753. ' -------------------------------------------------------------------------
  2754. ' Shortcutauswertung Copyright (c) 1995 by 
  2755. ,Ulli Gruszka
  2756. ' -------------------------------------------------------------------------
  2757. ' Aufruf:
  2758. ' ... sollte unmittelbar nachdem EVNT_MULTI() ein Tastaturereignis
  2759. ' gemeldet hat erfolgen. Dabei werden k_state& und key& aus EVNT_MULTI(),
  2760. ' sowie die 
  2761. 'Adresse des zu durchsuchenden Men
  2762. baumes (menu%) 
  2763. bergeben.
  2764. ckgabe:
  2765. ' Falls ein Men
  2766. eintrag gefunden wurde, dessen Shortcut der gedr
  2767. ckten
  2768. ' Tastenkombination entspricht, werden die Objektnummern des Eintrages und
  2769. ' des zugeh
  2770. rigen Titels zur
  2771. ckgeliefert, anderenfalls FALSE.
  2772. ' -------------------------------------------------------------------------
  2773.   LOCAL sc$,asc&,obj&,box&,ibox&
  2774.   key&=SHR&(key&,8)                                ! SCAN-Code der Taste
  2775.   IF key&>=120 AND key&<=129
  2776.     SUB key&,118                                   ! f
  2777. r Zifferntasten 1-0
  2778.     asc&=PEEK({
  2779. %XBIOS(16,L:-1,L:-1,L:-1)}+key&)     ! ASCII-Code
  2780.   ELSE
  2781.     asc&=PEEK({
  2782. %XBIOS(16,L:-1,L:-1,L:-1)+4}+key&)   ! ASCII-Code (geSHIFTet!)
  2783.   ENDIF
  2784.   ' ----------------------Men
  2785. -Shortcut nachbilden--------------------------
  2786.   SELECT k_state&
  2787.     '
  2788.   CASE 0                                           ! Funktionstasten
  2789.     SELECT key&                                    ! Umst
  2790. ndlich, aber wer
  2791.     CASE 59 TO 68                                  ! hat 'ne bessere Idee?
  2792.       IF key&=68
  2793.         sc$="F1"                                   ! Das wird zu F10,
  2794.         SUB key&,10                                ! das sp
  2795. ter zur Null
  2796.       ELSE
  2797.         sc$="F"                                    ! und das zu F1 - F9
  2798.       ENDIF
  2799.       asc&=ASC(STR$(key&-58))                      ! wird unten wieder gewandelt
  2800.     ENDSELECT
  2801.   CASE 1,2,3                                       ! SHIFT links, rechts,
  2802.     sc$=CHR$(1)                                    !       links&rechts
  2803.   CASE 4                                           ! CONTROL
  2804.     sc$="^"
  2805.   CASE 5,6,7                                       ! CONTROL & SHIFT l, r,
  2806.     sc$=CHR$(1)+"^"                                !                 l&r
  2807.   CASE 8                                           ! ALTERNATE
  2808.     sc$=CHR$(7)
  2809.   CASE 9,10,11                                     ! ALT & SHIFT l, r,
  2810.     sc$=CHR$(1)+CHR$(7)                            !             l&r
  2811.   CASE 12                                          ! ALT & CONTROL
  2812.     sc$=CHR$(7)+"^"
  2813.   CASE 13                                          ! ALT & CONTROL & SHIFT(r)
  2814.     sc$=CHR$(7)+"^"+CHR$(1)
  2815.   ENDSELECT
  2816.   '                            Anmerkung: ALT & CONTROL & DELETE konnte ich
  2817.   '                                       leider nicht einbauen, da es bei
  2818.   '                                       mir w
  2819. hrend der Entwicklung wieder-
  2820.   '                                       holt zu unerkl
  2821. rlichen Abst
  2822.   '                                       kam ...                      (;-)
  2823.   IF sc$>""                             ! Diese Abfrage l
  2824. schen, falls SCs
  2825.     '                                     ohne Umschalttasten vorkommen.
  2826.     '
  2827.     sc$=" "+sc$+CHR$(asc&)+" "                     ! Suchstring komplettieren
  2828.     '
  2829.     ' ----------------------Men
  2830. -Shortcut suchen-----------------------------
  2831.     '
  2832.     obj&=OB_NEXT(menu%,OB_TAIL(menu%,2))           ! Damit geht's los ...
  2833.     WHILE BTST(OB_FLAGS(menu%,obj&),5)=FALSE       ! Bis zum letzten Objekt
  2834.       '
  2835.       INC obj&
  2836.       IF OB_TYPE(menu%,obj&)=28                    ! Nur String-
  2837.         IF BTST(OB_STATE(menu%,obj&),3)=FALSE      ! die nicht disabled sind!
  2838.           IF RINSTR(CHAR{OB_SPEC(menu%,obj&)},sc$) ! Falls Shortcut vorhanden,
  2839.             '                                        ist obj& der Eintrag.
  2840.             '                                        Weiter mit:
  2841.             ' ------------Titel suchen----------------------------------
  2842.             titel&=2                               ! Offset (1. Titel hat immer
  2843.             '                                                den 
  2844. %Index 3.)
  2845.             box&=obj&                              ! Zur Suche der Parent-BOX.
  2846.             DO
  2847.               box&=OB_NEXT(menu%,box&)             ! Bis die Parent-BOX des
  2848.             LOOP WHILE box&>obj&                   ! Eintrages auftaucht ...
  2849.             '
  2850.             ibox&=OB_NEXT(menu%,1)                 ! IBOX mit allen 
  2851.             WHILE ibox&<box&                       ! Wieder bis zur BOX mit
  2852.               INC ibox&                            ! dem Eintrag hochz
  2853. hlen,
  2854.               IF OB_TYPE(menu%,ibox&)=20           ! und falls Objekt eine BOX
  2855.                 INC titel&                         ! ist, dem Titel n
  2856. hern ...
  2857.               ENDIF
  2858.             WEND
  2859.             ' ------------Funktionsende---------------------------------
  2860.             RETURN obj&                            ! Ergebnis abliefern
  2861.             ' ---------------------------------------------------------------
  2862.             '
  2863.           ENDIF ! RINSTR
  2864.         ENDIF ! OB_STATE
  2865.       ENDIF ! OB_TYPE
  2866.       '
  2867.     WEND                                           ! War nix, weiter bis
  2868.     '                                                zum Ende ...
  2869.   ENDIF ! sc$
  2870.   RETURN FALSE                                     ! Shortcut nicht vorhanden
  2871. ENDFUNC
  2872. lSetzen der OB_STATES und OB_FLAGS                             GFA-Util
  2873. Autor: 
  2874.   @ AC3
  2875. ' MODULE Gem-Help
  2876. ' Version 1.2
  2877. ' (C) 22.10.1993 von 
  2878. INLINE 
  2879.  ,108
  2880. GOSUB init_states
  2881. ' --!PP
  2882. > PROCEDURE init_states
  2883.   ' Objekt-Flags
  2884.     ' ++!sy
  2885.     LET selectable&=0
  2886.     LET default&=1
  2887.     LET exit&=2
  2888.     LET editable&=3
  2889.     LET rbutton&=4
  2890.     LET lastob&=5
  2891.     LET touchexit&=6
  2892.     LET hidetree&=7
  2893.     LET indirect&=8
  2894.     '
  2895.     ' Objekt-States
  2896.     '
  2897.     LET selected&=0
  2898.     LET crossed&=1
  2899.     LET checked&=2
  2900.     LET disabled&=3
  2901.     LET outlined&=4
  2902.     LET shadowed&=5
  2903.     ' ++!sy
  2904. RETURN
  2905. ' --!PP
  2906. > PROCEDURE deffn_s
  2907.     ' Objekt-Flag abfragen
  2908.     DEFFN get_flag(tr%,obj&,f&)=BTST(OB_FLAGS(tr%,obj&),f&)
  2909.     ' Objekt-State abfragen
  2910.     DEFFN get_state(tr%,obj&,f&)=BTST(OB_STATE(tr%,obj&),f&)
  2911.     ' Objekt-Text abfragen
  2912.     DEFFN get_text$(tr%,obj&)=CHAR{C:
  2913.  (L:tr%,obj&)}
  2914. RETURN
  2915. > PROCEDURE set_text(tr%,obj&,text$,r!)
  2916.     '
  2917.     ' Universelle Object-Text-Belegung
  2918.     '
  2919.     ~WIND_UPDATE(1)
  2920.     CHAR{C:
  2921.  (L:tr%,obj&)}=text$
  2922.     IF r!=TRUE
  2923.         @redraw(tr%,obj&)
  2924.     ENDIF
  2925.     ~WIND_UPDATE(0)
  2926. RETURN
  2927. > PROCEDURE deselect(tr%,obj&,r!)
  2928.     '
  2929.     ' Objekt Deselektieren
  2930.     '
  2931.     ' tr% = Dialog-Baum 
  2932. 'Adresse
  2933.     ' obj&= 
  2934. %Index des Objektes
  2935.     ' r!  = Objekt neuzeichnen (TRUE = Ja, FALSE = Nein)
  2936.     '
  2937.     @clr_state(tr%,obj&,selected&,r!)
  2938. RETURN
  2939. > PROCEDURE select(tr%,obj&,r!)
  2940.     '
  2941.     ' Objekt Selektieren
  2942.     '
  2943.     ' tr% = Dialog-Baum 
  2944. 'Adresse
  2945.     ' obj&= 
  2946. %Index des Objektes
  2947.     ' r!  = Objekt neuzeichnen (TRUE = Ja, FALSE = Nein)
  2948.     '
  2949.     @set_state(tr%,obj&,selected&,r!)
  2950. RETURN
  2951. > PROCEDURE disable(tr%,obj&,r!)
  2952.     '
  2953.     ' Objekt Hellgedruckt (disabled) darstellen
  2954.     '
  2955.     ' tr% = Dialog-Baum 
  2956. 'Adresse
  2957.     ' obj&= 
  2958. %Index des Objektes
  2959.     ' r!  = Objekt neuzeichnen (TRUE = Ja, FALSE = Nein)
  2960.     '
  2961.     @set_state(tr%,obj&,disabled&,r!)
  2962. RETURN
  2963. > PROCEDURE able(tr%,obj&,r!)
  2964.     '
  2965.     ' Objekt Normal darstellen
  2966.     '
  2967.     ' tr% = Dialog-Baum 
  2968. 'Adresse
  2969.     ' obj&= 
  2970. %Index des Objektes
  2971.     ' r!  = Objekt neuzeichnen (TRUE = Ja, FALSE = Nein)
  2972.     '
  2973.     @clr_state(tr%,obj&,disabled&,r!)
  2974. RETURN
  2975. > PROCEDURE set_flag(tr%,obj&,f&,r!)
  2976.     '
  2977.     ' Objekt-Flag setzen
  2978.     '
  2979.     ' tr% = Dialog-Baum 
  2980. 'Adresse
  2981.     ' obj&= 
  2982. %Index des Objektes
  2983.     ' f&  = Flag, das gesetzt werden soll
  2984.     ' r!  = Objekt neuzeichnen (TRUE = Ja, FALSE = Nein)
  2985.     '
  2986.     OB_FLAGS(tr%,obj&)=BSET(OB_FLAGS(tr%,obj&),f&)
  2987.     '
  2988.     IF r!=TRUE
  2989.         @redraw(tr%,obj&)
  2990.     ENDIF
  2991. RETURN
  2992. > PROCEDURE clr_flag(tr%,obj&,f&,r!)
  2993.     '
  2994.     ' Objekt-Flag l
  2995. schen
  2996.     '
  2997.     ' tr% = Dialog-Baum 
  2998. 'Adresse
  2999.     ' obj&= 
  3000. %Index des Objektes
  3001.     ' f&  = Flag, das gel
  3002. scht werden soll
  3003.     ' r!  = Objekt neuzeichnen (TRUE = Ja, FALSE = Nein)
  3004.     '
  3005.     OB_FLAGS(tr%,obj&)=BCLR(OB_FLAGS(tr%,obj&),f&)
  3006.     '
  3007.     IF r!=TRUE
  3008.         @redraw(tr%,obj&)
  3009.     ENDIF
  3010. RETURN
  3011. > PROCEDURE change_flag(tr%,obj&,f&,r!)
  3012.     '
  3013.     ' Objekt-Flag 
  3014. ndern (aus EIN wird AUS, aus AUS wird EIN)
  3015.     '
  3016.     ' tr% = Dialog-Baum 
  3017. 'Adresse
  3018.     ' obj&= 
  3019. %Index des Objektes
  3020.     ' f&  = Flag, das ge
  3021. ndert werden soll
  3022.     ' r!  = Objekt neuzeichnen (TRUE = Ja, FALSE = Nein)
  3023.     '
  3024.     OB_FLAGS(tr%,obj&)=BCHG(OB_FLAGS(tr%,obj&),f&)
  3025.     '
  3026.     IF r!=TRUE
  3027.         @redraw(tr%,obj&)
  3028.     ENDIF
  3029. RETURN
  3030. > PROCEDURE set_state(tr%,obj&,f&,r!)
  3031.     '
  3032.     ' Objekt-State setzen
  3033.     '
  3034.     ' tr% = Dialog-Baum 
  3035. 'Adresse
  3036.     ' obj&= 
  3037. %Index des Objektes
  3038.     ' f&  = State, das gesetzt werden soll
  3039.     ' r!  = Objekt neuzeichnen (TRUE = Ja, FALSE = Nein)
  3040.     '
  3041.     OB_STATE(tr%,obj&)=BSET(OB_STATE(tr%,obj&),f&)
  3042.     '
  3043.     IF r!=TRUE
  3044.         @redraw(tr%,obj&)
  3045.     ENDIF
  3046. RETURN
  3047. > PROCEDURE clr_state(tr%,obj&,f&,r!)
  3048.     '
  3049.     ' Objekt-State l
  3050. schen
  3051.     '
  3052.     ' tr% = Dialog-Baum 
  3053. 'Adresse
  3054.     ' obj&= 
  3055. %Index des Objektes
  3056.     ' f&  = State, das gel
  3057. scht werden soll
  3058.     ' r!  = Objekt neuzeichnen (TRUE = Ja, FALSE = Nein)
  3059.     '
  3060.     OB_STATE(tr%,obj&)=BCLR(OB_STATE(tr%,obj&),f&)
  3061.     '
  3062.     IF r!=TRUE
  3063.         @redraw(tr%,obj&)
  3064.     ENDIF
  3065. RETURN
  3066. > PROCEDURE change_state(tr%,obj&,f&,r!)
  3067.     '
  3068.     ' Objekt-State 
  3069. ndern (aus EIN wird AUS, aus AUS wird EIN)
  3070.     '
  3071.     ' tr% = Dialog-Baum 
  3072. 'Adresse
  3073.     ' obj&= 
  3074. %Index des Objektes
  3075.     ' f&  = State, das ge
  3076. ndert werden soll
  3077.     ' r!  = Objekt neuzeichnen (TRUE = Ja, FALSE = Nein)
  3078.     '
  3079.     OB_STATE(tr%,obj&)=BCHG(OB_STATE(tr%,obj&),f&)
  3080.     '
  3081.     IF r!=TRUE
  3082.         @redraw(tr%,obj&)
  3083.     ENDIF
  3084. RETURN
  3085. !stg @alias redraw
  3086. > PROCEDURE redraw(tr%,obj&)
  3087.     '
  3088.     ' Objekt Redraw'en (Neuzeichnen)
  3089.     '
  3090.     ' tr% = Dialog-Baum 
  3091. 'Adresse
  3092.     ' obj&= 
  3093. %Index des Objektes
  3094.     '
  3095.     ~OBJC_DRAW(tr%,obj&,3,0,0,0,0)
  3096. RETURN
  3097. ' Ende von MODULE Gem-Help
  3098. lrsc_txt_scroll                                                GFA-Util
  3099. Autor: 
  3100. 1Oliver Schildmann @ LU
  3101. Die Routine habe ich auf einem TT geschrieben, wo sie auch recht
  3102. schnell lief. Auf einem 8 MHz ST h
  3103. tte es allerdings etwas schneller
  3104. sein k
  3105. nnen. Die gepostete Routine ist daher etwas 
  3106. berarbeitet und
  3107. findet erst in der n
  3108. chsten 
  3109. %XINFO-Version Verwendung (nur f
  3110. r den
  3111. Fall, dass sich jemand wundert, dass das Scrolling in 
  3112. %XINFO so
  3113. langsam und hier so schnell ist :-).
  3114. ' Hauptprogramm: Setzen des Pfades in den Dialog
  3115. ' Path.pos%=Len(Filename$)-Len(@Ob_text$(Fileinfo_adr%,Path_txt&))+1
  3116. ' TEXT-Feld darf _nicht_ leer sein (mit '_' auffuellen) -^ (oder direkt die
  3117. ' Werte des Objektes abfragen, s. DEFFN OB_TEXTLEN)
  3118. @Objc_text(Fileinfo_adr%,Path_txt&,Filename$,Path.pos%)
  3119. ' Jetzt Object-Abfrage mit FORM_DO. Aufbau im Dialog: <- C:\DIR1\F.TXT__ ->
  3120. ' Die Sortierung im Resourcebaum ist ausschlaggebend f
  3121. r 'links' und 'rechts'
  3122. ' alternativ kann man auch den Inhalt der BOXCHAR-
  3123.   (<-,->) abfragen.
  3124. ' Object& mit FORM_DO ermitteln
  3125. &Select Object&
  3126. Case Path_left&,Path_right&
  3127.  Path.pos%=@Objc_scroll(Fileinfo_adr%,Object&,Path_txt&,Path.pos%,Filename$)
  3128. Endselect
  3129. ' Unterroutinen
  3130. > procedure Objc_text(Adr%,Obj&,Text$,P%) ! Objekt mit neuem Text versehen
  3131. ' -----------
  3132. ' TEXT OBJECT
  3133. ' ----------- 1.2 080294
  3134. ' Parameter : Adr% (
  3135. 'Adresse des Objektbaumes, dem das Objekt angeh
  3136. '             Obj& (Nummer des Objektes)
  3137. '             Text$ (Text, der in das Objekt geschrieben wird)
  3138. '             P% (Position des Textes: 0=Normal, >0=Ausschnitt, <0=Auff
  3139. llen)
  3140. ' PreProc   : -
  3141. ' InlineProc: -
  3142. ' InlineFunc: -
  3143. ' Konstante : -
  3144. ' Variable  : -
  3145. If P%<>0
  3146.   If P%>0                                     ! Wenn P%>0, dann Ausschnitt
  3147.     Text$=Mid$(Text$,P%,Len(@Ob_text$(Adr%,Obj&))) ! berechnen
  3148.   Else                                        ! sonst mit "_" auff
  3149.     Text$=Text$+String$(Len(@Ob_text$(Adr%,Obj&))-Len(Text$),"_")
  3150.   Endif                                       ! da String kleiner als Feld
  3151. Endif
  3152. Text$=Left$(Text$,@Ob_textlen(Adr%,Obj&))
  3153. Char{{Ob_spec(Adr%,Obj&)}}=Text$
  3154. Deffn Ob_text$(Adr%,Obj&)=Char{{Ob_spec(Adr%,Obj&)}}
  3155. Deffn Ob_textlen(Adr%,Obj&)=Pred(Card{Ob_spec(Adr%,Obj&)+24})
  3156. Return
  3157. > Function Objc_scroll(Adr%,Obj&,Txt&,Pos%,Text$)
  3158. ' -----------------------
  3159. ' SCROLLBARES TEXT OBJECT
  3160. ' ----------------------- 1.1 280494
  3161. ' Parameter : Adr% (
  3162. 'Adresse des Objektbaumes, dem das Objekt angeh
  3163. '             Obj& (Nummer des Pfeil-Objektes)
  3164. '             Txt& (Nummer des Text-Objektes)
  3165. '             Text$ (Text, der in das Objekt geschrieben wird)
  3166. '             Pos% (Position des Textes)
  3167. ' PreProc   : -
  3168. ' InlineProc: Objc_select, Objc_draw, Objc_text
  3169. ' InlineFunc: Mousek
  3170. ' Konstante : -
  3171. ' Variable  : -
  3172. ckgabe  : Pos% (neue Position des Textes)
  3173. Repeat
  3174.   If Obj&=Pred(Txt&)                          ! Obj& links vom Text, also <-
  3175.     If Pos%>1                                 ! Position ist gr
  3176. sser 1, also
  3177.       Dec Pos%                                ! kann der Text zum Anfang
  3178.       @Objc_text(Adr%,Txt&,Text$,Pos%)
  3179.       @Objc_draw(Adr%,Txt&,5,0,0,0,0)
  3180.     Endif
  3181.   Else                                        ! Obj& rechts vom Text, also ->
  3182.     If Len(Text$)-Len(@Ob_text$(Adr%,Txt&))-Pos%+1>0  ! Wenn noch Text da,
  3183.       Inc Pos%                                ! Text zum Ende scrollen
  3184.       @Objc_text(Adr%,Txt&,Text$,Pos%)
  3185.       @Objc_draw(Adr%,Txt&,5,0,0,0,0)
  3186.     Endif
  3187.   Endif
  3188.   ~@Evnt_timer(20)                            ! 
  3189. %Pause f
  3190. r schnelle Computer
  3191. Until And(@Mousek,1)=False                    ! Bis linke Taste gel
  3192. st wird
  3193. Return Pos%
  3194. Endfunc
  3195. r @OBJC_DRAW() und ~@EVNT_TIMER() sollte man nat
  3196. rlich die 
  3197. #GEM-Aufrufe
  3198. ' verwenden, ~@MOUSEK ist ebenfalls ein 
  3199.  -Ersatz f
  3200. r den GFA-Befehl.
  3201. lShell-Kommunikation                                           GFA-Util
  3202. Hier steht noch nix!
  3203.                                              GFA-Util
  3204. Hier steht noch nix!
  3205. lZwischenspeicher                                              GFA-Util
  3206. lClipboard finden (nach Schildmann)                            GFA-Util
  3207. Autor: 
  3208. 1Oliver Schildmann @ LU
  3209. ' Pt$ (Zeichen f
  3210. r den Pfadtrenner; i.d.R. '\')
  3211. ' @Search.env(Env$) (durchsucht das Environment nach der Variablen Env$ und
  3212. '                    
  3213. bergibt den Wert in der globalen Variablen Env_value$)
  3214. &Drvmap (
  3215. bergibt alle verf
  3216. gbaren Laufwerke als 32-Bit-Vektor)
  3217. ' @Noq(Drive%) (ermittelt die Laufwerks-Nummer aus einem 32-Bit-Vektor)
  3218. ' @Exist(File$) (
  3219. berpr
  3220. ft Existenz einer Datei/eines Ordners/Laufwerks)
  3221. ' @Medium.protected(File$) (
  3222. berpr
  3223. ft mittels 
  3224.  , ob das Laufwerk der
  3225. '                           Datei File$ schreibgesch
  3226. tzt ist)
  3227. ' @Killfile(File$,Wipe!,Protected!) (l
  3228. scht File$, mit 
  3229. berschreiben 'Wipe!'
  3230. '                                    und mit Schreibschutz 'Protected!')
  3231. > function Init.clipbrd$          ! CLIPBRD ermitteln und initialisieren
  3232. ' ----------------------
  3233. ' CLIPBRD INITIALISIEREN
  3234. ' ---------------------- 1.1 130594
  3235. ' Parameter : -
  3236. ' PreProc   : -
  3237. ' InlineProc: -
  3238. ' InlineFunc: Search.env, 
  3239. &Drvmap, Noq, Exist, Medium.protected, Killfile
  3240. ' Konstante : Pt$
  3241. ' Variable  : -
  3242. ckgabe  : Pfad des Clipboards (ohne abschliessenden Trenner)
  3243. ' Anmerkung : Das Clipboard-Verzeichnis ist immer im Format 'X:\ORDNER'
  3244. Local Clipbrd$,Q%
  3245. ~Scrp_read(Clipbrd$)                  ! Erst im 
  3246.   nachsehen.  Wenn Inhalt
  3247. If Clipbrd$="" Or Mid$(Clipbrd$,2,2)<>":"+Pt$ Or Len(Clipbrd$)<4  ! leer oder
  3248.   Q%=Dpeek(1094)                      ! merkw
  3249. rdig, BOOT-Laufwerk feststellen
  3250.   Clipbrd$="CLIPBRD"                  ! Standard-Ordner und ENV-Variable
  3251.   If @Search.env(Clipbrd$) And Env_value$<>"" And Mid$(Env_value$,2,2)=":"+Pt$ And Len(Env_value$)>3 ! * AN OBERE ZEILE ANH
  3252. NGEN *
  3253.     Clipbrd$=Env_value$               ! Environment nach CLIPBRD absuchen
  3254.   Else if Q%>1 And Q%<=90             ! Wenn nicht, zuerst das BOOT-Laufwerk
  3255.     Clipbrd$=Chr$(65+Q%)+":"+Pt$+Clipbrd$ ! (wenn nicht A:, B: oder >Z:)
  3256.   Else if (@
  3257. &Drvmap And 4)>0           ! Existiert wenigstens Laufwerk C:?
  3258.     Clipbrd$="C:"+Pt$+Clipbrd$
  3259.   Else if (@
  3260. &Drvmap And -4)>0          ! sonst 1. nicht Disk-Laufwerk nehmen
  3261.     Clipbrd$=Chr$(64+@Noq(@
  3262. &Drvmap And -4))+":"+Pt$+Clipbrd$
  3263.   Else if Q%<=1                       ! Nun doch A: oder B: :-(
  3264.     Clipbrd$=Chr$(65+Q%)+":"+Pt$+Clipbrd$
  3265.   Else                                ! Hmm, da war ein Fehler in boot_dev!
  3266.     Clipbrd$="A:"+Pt$+Clipbrd$
  3267.   Endif
  3268. Endif
  3269. If Right$(Clipbrd$,1)=Pt$             ! ggf. abschliessenden "\" entfernen
  3270.   Clipbrd$=Left$(Clipbrd$,Pred(Len(Clipbrd$)))
  3271. Endif
  3272. If Not @Exist(Clipbrd$)               ! Wenn Ordner nicht existiert und
  3273.   If Not @Medium.protected(Clipbrd$)  ! wenn Laufwerk nicht gesch
  3274. tzt ist,
  3275.     Mkdir Clipbrd$                    ! Ordner anlegen
  3276.   Endif                               ! (momentan keine Rekursion!)
  3277. Endif
  3278. If @Exist(Clipbrd$)                   ! Wenn Ordner existiert,
  3279.   ~Scrp_write(Clipbrd$)               ! CLIPBRD-Pfad dem 
  3280.   bekanntgeben und
  3281.   Repeat                              ! alle SCRAP-Dateien l
  3282. schen (auch die
  3283.   Until Not @Killfile(Clipbrd$+Pt$+"SCRAP.*",False,True) ! mit Schreibschutz)
  3284. Else                                  ! Ansonsten wird der CLIPBRD-Pfad
  3285.   Clipbrd$=""                         ! wieder gel
  3286. scht.
  3287. Endif
  3288. Return Clipbrd$
  3289. Endfunc
  3290. > function Exist(Filename$)       ! Existiert ein Pfad/eine Datei
  3291. ' --------------------
  3292. ' EXISTIERT PFAD/DATEI
  3293. ' -------------------- 2.0 270494
  3294. ' Parameter : Filename$ (Dateiname mit Pfad und Extension, oder Pfad mit '\')
  3295. ' PreProc   : -
  3296. ' InlineProc: -
  3297. ' InlineFunc: 
  3298. &Drvmap
  3299. ' Konstante : Pt$
  3300. ' Variable  : -
  3301. If Len(Filename$)=3 And Right$(Filename$,2)=":"+Pt$   ! Filename ist ROOT?
  3302.   Return (@
  3303. &Drvmap And (2^(Asc(Upper$(Left$(Filename$,1)))-65)))>0
  3304. Else                                                  ! Ist Drive vorhanden?
  3305.   Return (
  3306. 'Fsfirst(Filename$+Chr$(0),63)=0)            ! Erweitert und f
  3307. Endif
  3308. Endfunc
  3309. Deffn 
  3310. &Drvmap=Gemdos(14,Gemdos(25))
  3311. ' Ermittele Potenz ( Q%=@Noq(2^Q%)-1 im Bereich von 0-30)
  3312. Deffn Noq(Q%)=Mul(Sub(Rinstr(Bin$(Q%,32),"1"),33),(Q%<>0))
  3313. lClipboard finden (nach R
  3314. ger)                                 GFA-Util
  3315. Autor: Frank R
  3316. ger @ OS2
  3317. FUNCTION find_clipbrd(set!,VAR clipbrd$)
  3318.   $F%
  3319.   LOCAL abbruch!
  3320.   LOCAL fehler|
  3321.   LOCAL drivemap&
  3322.   LOCAL fehler&
  3323.   LOCAL i&
  3324.   LOCAL d$
  3325.   LOCAL clipbrd%
  3326.   LOCAL drive$
  3327.   LOCAL neuord$
  3328.   CLR clipbrd$
  3329.   ~SCRP_READ(clipbrd$)
  3330.   FOR i&=0 TO 1
  3331.     IF LEN(clipbrd$)=0
  3332.       IF i&
  3333.         ~SHEL_ENVRN(clipbrd%,"SCRAPDIR")
  3334.       ELSE
  3335.         ~SHEL_ENVRN(clipbrd%,"CLIPBRD")
  3336.       ENDIF
  3337.       IF clipbrd%
  3338.         clipbrd$=CHAR{clipbrd%}
  3339.         clipbrd$=TRIM$(clipbrd$)
  3340.         IF LEFT$(clipbrd$)="="
  3341.           clipbrd$=TRIM$(MID$(clipbrd$,2))
  3342.         ENDIF
  3343.       ENDIF
  3344.     ENDIF
  3345.   NEXT i&
  3346.   IF LEN(clipbrd$)=0
  3347.     drivemap&=
  3348.  (dsetdrv&,
  3349. &GEMDOS(dgetdrv&)) AND &HFFFF
  3350.     FOR i&=0 TO 1
  3351.       drive$=CHR$(ASC("A")-2*(i&=0))   !C bzw. A
  3352.       '
  3353.       
  3354. 2' #UMBRUCH ANFANG!
  3355.       IF (i&=0 AND BTST(drivemap&,2)) OR (i&=1
  3356.       AND LEN(clipbrd$)=0 AND NOT abbruch!)
  3357.       
  3358. 0' #UMBRUCH ENDE!
  3359.       '
  3360.         IF FSFIRST(drive$+":\CLIPBRD",fa_direc&)=0
  3361.           ~SCRP_WRITE(drive$+":\CLIPBRD\")
  3362.           clipbrd$=drive$+":\CLIPBRD\"
  3363.         ELSE IF set!
  3364.           neuord$=drive$+":\CLIPBRD"+null$
  3365.           REPEAT
  3366.             fehler&=
  3367.  (dcreate&,L:V:neuord$)
  3368.             IF fehler&
  3369.               '
  3370.               
  3371. 2' #UMBRUCH ANFANG!
  3372.               fehler|=@my_alert(stop&,"Fehler bei
  3373.               
  3374. 'Dcreate()=
  3375.  (75)!|Returncode:
  3376.               "+STR$(fehler&)+"|beim Anlegen des
  3377.               Ordners|"+@pfad_format$(LEFT$(neuord$,
  3378.               PRED(LEN(neuord$))),40),2,"Abbruch|Nochmal")
  3379.               
  3380. 0' #UMBRUCH ENDE!
  3381.               '
  3382.               abbruch!=fehler|=1
  3383.               EXIT IF abbruch!
  3384.             ENDIF
  3385.           UNTIL fehler&=0
  3386.           IF NOT abbruch!
  3387.             ~SCRP_WRITE(drive$+":\CLIPBRD\")
  3388.             clipbrd$=drive$+":\CLIPBRD\"
  3389.           ENDIF
  3390.         ENDIF
  3391.       ENDIF
  3392.     NEXT i&
  3393.   ELSE IF RIGHT$(clipbrd$)<>"\"
  3394.     clipbrd$=clipbrd$+"\"
  3395.   ENDIF
  3396.   RETURN LEN(clipbrd$)=0 OR abbruch!
  3397. ENDFUNC
  3398. schen des Clipboards                                        GFA-Util
  3399. Autor: 
  3400. 0Gregor Duchalski @ DO
  3401. > FUNCTION 
  3402. *scrp_clear
  3403.   $F%
  3404.   LOCAL stat&,file$
  3405.   ' L
  3406. scht das Klembrett...
  3407.   ~GRAF_MOUSE(2,0)
  3408.   file$=@scrp_file$                 ! Erste Datei suchen
  3409.   WHILE file$<>""                   ! Solange bis keine mehr da...
  3410.    file$=clipbrd$+file$            ! Ganzer Pfad
  3411.    stat&=@f_kill(file$)            ! ...l
  3412. schen
  3413.    EXIT IF stat&                   ! Fehlgeschlagen?
  3414.    file$=@scrp_file$               ! N
  3415. chste Datei suchen
  3416.   WEND
  3417.   ~GRAF_MOUSE(0,0)
  3418.   IF stat&                         ! Wenn Fehler...
  3419.    stat&=130                       ! ...dann dieser Fehler-Code
  3420.   ENDIF
  3421.   RETURN stat&
  3422. ENDFUNC
  3423. lLesen einer Datei vom Clipboard                               GFA-Util
  3424. Autor: 
  3425. 0Gregor Duchalski @ DO
  3426. > FUNCTION scrp_file$
  3427.   LOCAL stat&,file$
  3428.   ' Liest eine Datei vom Klemmbrett...
  3429.   ~FSETDTA(ADD(BASEPAGE,128))       ! 
  3430. 'Adresse sicherheitshalber setzen
  3431.   file$=clipbrd$+"SCRAP.*"          ! Datei...
  3432.   stat&=FSFIRST(file$,&X0)          ! ...suchen
  3433.   IF stat&=0                        ! Gefunden...
  3434.    file$=CHAR{ADD(BASEPAGE,158)}    ! ...Namen auslesen
  3435.   RETURN file$
  3436.   ENDIF
  3437.   RETURN ""                         ! Nichts drin
  3438. ENDFUNC
  3439. lGEMDOS                                                        GFA-Util
  3440.             (F...)
  3441.           (T...)
  3442.           (P...)
  3443.          (M...)
  3444.            (S...)
  3445.       (D...)
  3446.   (C...)
  3447. lDateifunktionen                                               GFA-Util
  3448.          (OPEN "A")
  3449.            (Dateiattribute 
  3450. ndern)
  3451.            (BGET #1,a%,l%)
  3452.            (BPUT #1,a%,l%)
  3453.           (BLOAD datei$)
  3454.           (BSAVE datei$)
  3455.           (CLOSE(#1))
  3456.          (OPEN "O")
  3457.             (EOF(#1))
  3458.           (LINE INPUT #1,a$)
  3459.            (
  3460. $KILL datei$)
  3461.             (LOF(#1))
  3462.             (LOC(#1))
  3463.           (MKDIR ordner$)
  3464.             (OUT #1)
  3465.            (OUT& #1)
  3466.            (OUT% #1)
  3467.            (OPEN "I")
  3468.           (PRINT #1,a$;)
  3469.         (PRINT #1,a$)
  3470.          (RENAME alt$ AS neu$)
  3471.           (RMDIR ordner$)
  3472.            (SEEK #1,pos%)
  3473.          (OPEN "U")
  3474.             Existenz einer Datei testen
  3475.      Datei-Info ermitteln
  3476.       Existenz eines Laufwerkes ermitteln
  3477.      Existenz eines Ordners ermitteln
  3478.             Extrahiert Dateinamen mit Punkt
  3479.            Extrahiert Dateinamen ohne Punkt
  3480.              Extrahiert die Extension
  3481.             Extrahiert den Pfad mit Punkt
  3482.            Extrahiert den Pfad ohne Punkt
  3483. berpr
  3484. fen des Fastload-Flags
  3485.      Setzen des Fastload-Flags
  3486.         Schreibschutz testen
  3487.       Disknamen lesen
  3488.        Disknamen schreiben
  3489.           Datei kopieren (nach Duchalski)
  3490.          Datei kopieren1 (nach Gruszka)
  3491.          Datei kopieren2 (nach Gruszka)
  3492.     Lange Pfadnamen k
  3493. rzen (nach Dunkel)
  3494.      Lange Pfadnamen k
  3495. rzen (nach R
  3496.      Lange Pfadnamen k
  3497. rzen (nach Klasen)
  3498.       Extender zwangsweise(!) vorgeben (nach Wedding)
  3499.     Extender zwangsweise(!) vorgeben (nach Harder)
  3500.     Filenamen 'formatieren'
  3501.       Blinken der Laufwerkslampen
  3502.          Aktuellen Pfad ermitteln
  3503.           Bei bestehender Datei die Extension 
  3504. ndern
  3505.     Gr
  3506. te Versionsnummer verschiedener Files ausgeben
  3507.     Extrahiert den Pfad ohne Datei
  3508.      Extrahiert die Datei aus einem Pfad
  3509. lf_close()                                                     GFA-Util
  3510. Autor: 
  3511. 0Gregor Duchalski @ DO
  3512. ' CLOSE #1
  3513. DEFFN f_close(fh&)=
  3514.  (62,fh&)
  3515. lf_out()                                                       GFA-Util
  3516. Autor: 
  3517. 0Gregor Duchalski @ DO
  3518. ' OUT #1,a|
  3519. DEFFN f_out(fh&,a|)=
  3520.  (64,fh&,L:1,L:V:a|)
  3521. lf_outw()                                                      GFA-Util
  3522. Autor: 
  3523. 0Gregor Duchalski @ DO
  3524. ' OUT& #1,a&
  3525. DEFFN f_outw(fh&,a&)=
  3526.  (64,fh&,L:2,L:V:a&)
  3527. lf_outl()                                                      GFA-Util
  3528. Autor: 
  3529. 0Gregor Duchalski @ DO
  3530. ' OUT% #1,a%
  3531. DEFFN f_outl(fh&,a%)=
  3532.  (64,fh&,L:4,L:V:a%)
  3533. lf_bput()                                                      GFA-Util
  3534. Autor: 
  3535. 0Gregor Duchalski @ DO
  3536. ' BPUT #1,a%,l%
  3537. DEFFN f_bput(fh&,a%,l%)=
  3538.  (64,fh&,L:l%,L:a%)
  3539. lf_bget()                                                      GFA-Util
  3540. Autor: 
  3541. 0Gregor Duchalski @ DO
  3542. ' BGET #1,a%,l%
  3543. DEFFN f_bget(fh&,a%,l%)=
  3544.  (63,fh&,L:l%,L:a%)
  3545. lf_print()                                                     GFA-Util
  3546. Autor: 
  3547. 0Gregor Duchalski @ DO
  3548. ' PRINT #1,a$;
  3549. DEFFN f_print(fh&,a$)=
  3550.  (64,fh&,L:LEN(a$),L:V:a$)
  3551. lf_seek()                                                      GFA-Util
  3552. Autor: 
  3553. 0Gregor Duchalski @ DO
  3554. ' SEEK #1,pos%
  3555. DEFFN f_seek(fh&,pos%)=
  3556.  (66,L:pos%,fh&,0)
  3557. lf_loc()                                                       GFA-Util
  3558. Autor: 
  3559. 0Gregor Duchalski @ DO
  3560. ' LOC(#1)
  3561. DEFFN f_loc(fh&)=
  3562.  (66,L:0,fh&,1)
  3563. lf_rename()                                                    GFA-Util
  3564. Autor: 
  3565. 0Gregor Duchalski @ DO
  3566. > FUNCTION f_rename(a$,b$)
  3567.   $F%
  3568.   ' RENAME a$ AS b$
  3569.   a$=a$+CHR$(0)
  3570.   b$=b$+CHR$(0)
  3571.   RETURN 
  3572.  (86,0,L:V:a$,L:V:b$)
  3573. ENDFUNC
  3574. lf_kill()                                                      GFA-Util
  3575. Autor: 
  3576. 0Gregor Duchalski @ DO
  3577. > FUNCTION f_kill(a$)
  3578.   $F%
  3579. $KILL a$
  3580.   a$=a$+CHR$(0)
  3581.   RETURN 
  3582.  (65,L:V:a$)
  3583. ENDFUNC
  3584. lf_rmdir()                                                     GFA-Util
  3585. Autor: 
  3586. 0Gregor Duchalski @ DO
  3587. > FUNCTION f_rmdir(a$)
  3588.   $F%
  3589.   ' RMDIR a$
  3590.   a$=a$+CHR$(0)
  3591.   RETURN 
  3592.  (58,L:V:a$)
  3593. ENDFUNC
  3594. lf_mkdir()                                                     GFA-Util
  3595. Autor: 
  3596. 0Gregor Duchalski @ DO
  3597. > FUNCTION f_mkdir(a$)
  3598.   $F%
  3599.   ' MKDIR a$
  3600.   a$=a$+CHR$(0)
  3601.   RETURN 
  3602.  (57,L:V:a$)
  3603. ENDFUNC
  3604. lf_create()                                                    GFA-Util
  3605. Autor: 
  3606. 0Gregor Duchalski @ DO
  3607. > FUNCTION f_create(a$)
  3608.   $F%
  3609.   ' OPEN "O"
  3610.   a$=a$+CHR$(0)
  3611.   RETURN 
  3612.  (60,L:V:a$,0)
  3613. ENDFUNC
  3614. lf_open()                                                      GFA-Util
  3615. Autor: 
  3616. 0Gregor Duchalski @ DO
  3617. > FUNCTION f_open(a$)
  3618.   $F%
  3619.   ' OPEN "I"
  3620.   a$=a$+CHR$(0)
  3621.   RETURN 
  3622.  (61,L:V:a$,0)
  3623. ENDFUNC
  3624. lf_update()                                                    GFA-Util
  3625. Autor: 
  3626. 0Gregor Duchalski @ DO
  3627. > FUNCTION f_update(a$)
  3628.   $F%
  3629.   ' OPEN "U"
  3630.   a$=a$+CHR$(0)
  3631.   RETURN 
  3632.  (61,L:V:a$,2)
  3633. ENDFUNC
  3634. lf_append()                                                    GFA-Util
  3635. Autor: 
  3636. 0Gregor Duchalski @ DO
  3637. > FUNCTION f_append(a$)
  3638.   $F%
  3639.   LOCAL fh&,a%
  3640.   ' OPEN "A"
  3641.   a$=a$+CHR$(0)
  3642.   fh&=
  3643.  (61,L:V:a$,2)               ! OPEN "U"
  3644.   IF fh&=-33                           ! Existiert nicht...
  3645.    fh&=
  3646.  (60,L:V:a$,0)             ! OPEN "O"
  3647.   ENDIF
  3648.   IF fh&>0
  3649.    a%=
  3650.  (66,L:0,fh&,2)             ! SEEK #1,lof%
  3651.    IF a%<0
  3652.     RETURN a%                          ! Error beim Seeken
  3653.    ENDIF
  3654.   ENDIF
  3655.   RETURN fh&
  3656. ENDFUNC
  3657. lf_lof()                                                       GFA-Util
  3658. Autor: 
  3659. 0Gregor Duchalski @ DO
  3660. > FUNCTION f_lof(fh&)
  3661.   $F%
  3662.   LOCAL pos%,lof%
  3663.   ' LOF(#1)
  3664.   pos%=
  3665.  (66,L:0,fh&,1)                       ! LOC(#1)
  3666.   lof%=
  3667.  (66,L:0,fh&,2)                       ! SEEK #1,LOF(#1)
  3668.  (66,L:pos%,fh&,0)                        ! SEEK #1,LOC(#1)
  3669.   RETURN lof%
  3670. ENDFUNC
  3671. lf_eof()                                                       GFA-Util
  3672. Autor: 
  3673. 0Gregor Duchalski @ DO
  3674. > FUNCTION f_eof(fh&)
  3675.   $F%
  3676.   LOCAL pos%,lof%
  3677.   ' EOF(#1)
  3678.   pos%=
  3679.  (66,L:0,fh&,1)                       ! LOC(#1)
  3680.   lof%=
  3681.  (66,L:0,fh&,2)                       ! SEEK #1,LOF(#1)
  3682.  (66,L:pos%,fh&,0)                        ! SEEK #1,LOC(#1)
  3683.   RETURN pos%>=lof%                               ! EOF(#1)
  3684. ENDFUNC
  3685. lf_println()                                                   GFA-Util
  3686. Autor: 
  3687. 0Gregor Duchalski @ DO
  3688. > FUNCTION f_println(fh&,a$)
  3689.   $F%
  3690.   ' PRINT #1,a$
  3691.   a$=a$+CHR$(13)+CHR$(10)
  3692.   RETURN 
  3693.  (64,fh&,L:LEN(a$),L:V:a$)
  3694. ENDFUNC
  3695. lf_input()                                                     GFA-Util
  3696. Autor: 
  3697. 0Gregor Duchalski @ DO
  3698. > FUNCTION f_input$(fh&)
  3699.   LOCAL a|,e%,a$,b$
  3700.   ' LINE INPUT #1,a$
  3701.   b$=CHR$(13)+CHR$(10)                ! Linefeed
  3702.   WHILE RIGHT$(a$,2)<>b$
  3703.    e%=
  3704.  (63,fh&,L:1,L:V:a|)      ! INP #1,a|
  3705.    EXIT IF e%<>1                     ! EOF(#1)
  3706.    a$=a$+CHR$(a|)
  3707.   WEND
  3708.   IF RIGHT$(a$,2)=b$
  3709.    a$=LEFT$(a$,SUB(LEN(a$),2))       ! LF abh
  3710.   ENDIF
  3711.   RETURN a$
  3712. ENDFUNC
  3713. lf_bload()                                                     GFA-Util
  3714. Autor: 
  3715. 0Gregor Duchalski @ DO
  3716. > FUNCTION f_bload(file$,adr%)
  3717.   $F%
  3718.   LOCAL fh&,lof%,pos%
  3719.   ' BLOAD file$,adr%
  3720.   file$=file$+CHR$(0)
  3721.   ~GRAF_MOUSE(2,0)
  3722.   fh&=
  3723.  (61,L:V:file$,0)      ! f_open
  3724.   IF fh&>0
  3725.    pos%=
  3726.  (66,L:0,fh&,1)     ! LOC(#1)
  3727.    lof%=
  3728.  (66,L:0,fh&,2)     ! f_seek(LOF(#1))
  3729.  (66,L:pos%,fh&,0)      ! f_seek(LOC(#1))
  3730.  (63,fh&,L:lof%,L:adr%) ! f_read
  3731.  (62,fh&)               ! f_close
  3732.   ENDIF
  3733.   ~GRAF_MOUSE(0,0)
  3734.   RETURN lof%                     ! L
  3735. nge der Datei
  3736. ENDFUNC
  3737. lf_bsave()                                                     GFA-Util
  3738. Autor: 
  3739. 0Gregor Duchalski @ DO
  3740. > FUNCTION f_bsave(file$,adr%,lof%)
  3741.   $F%
  3742.   LOCAL fh&
  3743.   ' BSAVE file$,adr%,lof%
  3744.   ~GRAF_MOUSE(2,0)
  3745.   fh&=
  3746.  (60,L:V:file$,0)      ! f_create
  3747.   IF fh&>0
  3748.  (64,fh&,L:lof%,L:adr%) ! f_write
  3749.  (62,fh&)               ! f_close
  3750.   ENDIF
  3751.   ~GRAF_MOUSE(0,0)
  3752.   RETURN fh&
  3753. ENDFUNC
  3754. lfile$()                                                       GFA-Util
  3755. Autor: 
  3756. 0Gregor Duchalski @ DO
  3757. > FUNCTION file$(a$)
  3758.   LOCAL a&
  3759.   ' Extrahiert Dateinamen: "D:\TEST\TEST.GFA" --> "TEST.GFA"
  3760.   IF a$<>""
  3761.    a&=RINSTR(a$,"\")          ! Backslash suchen
  3762.    IF a&                      ! Wenn ja...
  3763.     a$=MID$(a$,SUCC(a&))     ! Extrahiere Dateinamen...
  3764.     RETURN TRIM$(a$)         ! ...ohne Spaces
  3765.    ELSE
  3766.     RETURN a$
  3767.    ENDIF
  3768.   ENDIF
  3769.   RETURN ""                    ! Sonst kein Filename
  3770. ENDFUNC
  3771. lfile.$()                                                      GFA-Util
  3772. Autor: 
  3773. 0Gregor Duchalski @ DO
  3774. > FUNCTION file.$(a$)
  3775.   LOCAL a&
  3776.   ' Extrahiert Dateinamen ohne '.': "D:\TEST\TEST.GFA" --> "TEST"
  3777.   a$=@file$(a$)
  3778.   a&=INSTR(a$,".")
  3779.   IF a&
  3780.    RETURN LEFT$(a$,PRED(a&))
  3781.   ENDIF
  3782.   RETURN a$
  3783. ENDFUNC
  3784. lext$()                                                        GFA-Util
  3785. Autor: 
  3786. 0Gregor Duchalski @ DO
  3787. > FUNCTION ext$(a$)
  3788.   LOCAL a&
  3789.   ' Extrahiert Dateiextender: "D:\TEST.GFA" --> "GFA"
  3790.   a&=RINSTR(a$,".")          ! Punkt suchen
  3791.   IF a&                      ! Wenn vorhanden...
  3792.    RETURN MID$(a$,SUCC(a&))  ! ...extrahiere Extender
  3793.   ENDIF
  3794.   RETURN ""
  3795. ENDFUNC
  3796. lpfad$()                                                       GFA-Util
  3797. Autor: 
  3798. 0Gregor Duchalski @ DO
  3799. ' Extr. Pfadnamen: "D:\TEST.GFA" --> "D:\"
  3800. DEFFN pfad$(a$)=LEFT$(a$,RINSTR(a$,"\"))
  3801. lpfad.$()                                                      GFA-Util
  3802. Autor: 
  3803. 0Gregor Duchalski @ DO
  3804. ' Extr. Pfadnamen: "D:\TEST.GFA" --> "D:\TEST."
  3805. DEFFN pfad.$(a$)=LEFT$(a$,RINSTR(a$,"."))
  3806. lf_attr()                                                      GFA-Util
  3807. Autor: Frank R
  3808. ger @ OS2
  3809. ' Die Funktion liefert entweder die neuen Attribute der Datei oder
  3810. ' einen negativen Fehlercode!
  3811. ' neuattr&=@fattrbit("XYZ.DAT",TRUE,0)   ! RO-Bit setzen
  3812. ' oder
  3813. ' neuattr&=@fattrbit("XYZ.DAT",FALSE,0)  ! RO-Bit l
  3814. schen
  3815. FUNCTION fattrbit(fname$,set!,bit&)
  3816.   LOCAL fehler&
  3817.   fname$=fname$+CHR$(0)
  3818.   fehler&=
  3819.  (67,L:V:fname$,0,0)  ! Lesen
  3820.   IF fehler&>=0
  3821.     IF set!
  3822.       fehler&=BSET(fehler&,bit&)  ! Setzen
  3823.     ELSE
  3824.       fehler&=BCLR(fehler&,bit&)  ! L
  3825. schen
  3826.     ENDIF
  3827.     '
  3828.     fehler&=
  3829.  (67,L:V:fname$,1,fehler&)  ! Schreiben
  3830.   ENDIF
  3831.   RETURN fehler&
  3832. ENDFUNC
  3833. lexist()                                                       GFA-Util
  3834. Autor: 
  3835.   @ AC3
  3836. > FUNCTION exist(such$)
  3837.   $F%
  3838.   ~FSETDTA(BASEPAGE+128)
  3839.   IF FSFIRST(such$+CHR$(0),&X10000)=0
  3840.     RETURN TRUE
  3841.   ENDIF
  3842.   RETURN FALSE
  3843. ENDFUNC
  3844. lget_fileinfo()                                                GFA-Util
  3845. Autor: 
  3846. 0Gregor Duchalski @ DO
  3847. ' Ermittelt die Datei-Infos...
  3848. > FUNCTION get_fileinfo(datei$,VAR datum$,uhr$,laenge%)
  3849.   LOCAL a|,a&,b&,f&
  3850.   LOCAL sek|,min|,std|,tag|,mon|,jhr&
  3851.   f&=FSFIRST(datei$,0)          ! Datei suchen...
  3852.   IF f&=0                       ! ...gefunden
  3853.    a|=BYTE{BASEPAGE+128+21}     ! Attribute
  3854.    a&=WORD{BASEPAGE+128+22}     ! Uhrzeit
  3855.    b&=WORD{BASEPAGE+128+24}     ! Datum
  3856.    laenge%={BASEPAGE+128+26}    ! L
  3857.    sek|=(a& AND &X11111)*2
  3858.    min|=SHR(a&,5) AND &X111111
  3859.    std|=SHR(a&,11) AND &X11111
  3860.    uhr$=@null$(std|,2)+":"+@null$(min|,2)+":"+@null$(sek|,2)
  3861.    tag|=b& AND &X11111
  3862.    mon|=SHR(b&,5) AND &X1111
  3863.    jhr&=(SHR(b&,9) AND &X11111)+1980
  3864.    datum$=@null$(tag|,2)+"."+@null$(mon|,2)+"."+@null$(jhr&,4)
  3865.    RETURN TRUE
  3866.   ENDIF
  3867.   RETURN FALSE
  3868. ENDFUNC
  3869. lexist_drive()                                                 GFA-Util
  3870. Autor: Peter Harder @ NF
  3871. FUNCTION exist_drive(pfad$)
  3872.   $F%
  3873.   ' gibt TRUE zur
  3874. ck, falls ein bestimmtes Laufwerk exisiert,
  3875.   ' der erste Buchstabe des 
  3876. bergebenen Stringvariable ist dabei Ma
  3877. geblich
  3878.   ' Aufrufbeispiel: IF @exist_drive("C:\WORDPLUS\BRIEF.DOC")=TRUE
  3879.   LOCAL drive!,drives%,byte&
  3880.   pfad$=UPPER$(pfad$)
  3881.   IF MID$(pfad$,2,1)=":" OR LEN(pfad$)=1
  3882.     byte&=ASC(pfad$)-65
  3883.     drives%=
  3884.  (14,
  3885. &GEMDOS(25))  ! Laut Profibuch S 223
  3886.     IF BTST(drives%,byte&)=TRUE
  3887.       drive!=TRUE
  3888.     ELSE
  3889.       drive!=FALSE
  3890.     ENDIF
  3891.   ELSE
  3892.     drive!=TRUE
  3893.   ENDIF
  3894.   RETURN drive!
  3895. ENDFUNC
  3896. lexist_ordner()                                                GFA-Util
  3897. Autor: Peter Harder @ NF
  3898. FUNCTION exist_ordner(ordner$)
  3899.   $F%
  3900.   ' gibt TRUE zur
  3901. ck, falls ein bestimmter Ordner exisiert
  3902.   ' Aufrufbeispiel: IF @exist_ordner("C:\WORDPLUS")=TRUE
  3903.   ~FSETDTA(BASEPAGE+128)                !Setzen der Disktransferadresse
  3904.   IF FSFIRST(ordner$+CHR$(0),&X10000)=0 !Dateisuche mit gesetztem Ordnerbit,
  3905.     RETURN TRUE                         !findet aber auch normale Dateien
  3906.   ELSE
  3907.     RETURN FALSE
  3908.   ENDIF
  3909. ENDFUNC
  3910. lcheck_fastload()                                              GFA-Util
  3911. Autor: 
  3912. 0Gregor Duchalski @ DO
  3913. > FUNCTION check_fastload(a$)
  3914. berpr
  3915. ft das FASTLOAD-Flag im Programmheader (1=an/0=aus)...
  3916.   a%=0
  3917.   OPEN "U",#1,a$
  3918.   SEEK #1,&H16
  3919.   BGET #1,V:a%,4
  3920.   CLOSE #1
  3921.   RETURN -a%
  3922. ENDFUNC
  3923. lset_fastload()                                                GFA-Util
  3924. Autor: 
  3925. 0Gregor Duchalski @ DO
  3926. > PROCEDURE set_fastload(a$,a%)
  3927.   ' Setzt das FASTLOAD-Flag im Programmheader (1=an/0=aus)...
  3928.   a%=ABS(a%)
  3929.   OPEN "U",#1,a$
  3930.   SEEK #1,&H16
  3931.   BPUT #1,V:a%,4
  3932.   CLOSE #1
  3933. RETURN
  3934. lprotected()                                                   GFA-Util
  3935. Autor: 
  3936. 0Gregor Duchalski @ DO
  3937. ' Testet, ob die Datei Schreibgesch
  3938. tz ist...
  3939. ' -1: ja, -33: nicht gefunden, 0: gefunden und nicht protected
  3940. > FUNCTION protected(a$)
  3941.   LOCAL a&,a|
  3942.   a&=FSFIRST(a$,0)               !Datei suchen...
  3943.   IF a&=0                        !...Gefunden
  3944.    a|=BYTE{BASEPAGE+128+21}
  3945.    RETURN BTST(a|,0)             !Schreibschutz gesetzt
  3946.   ENDIF
  3947.   RETURN a&
  3948. ENDFUNC
  3949. lgd_copy()                                                     GFA-Util
  3950. Autor: 
  3951. 0Gregor Duchalski @ DO
  3952. ' Kopiert eine Datei: copy(source$,dest$)...
  3953. > PROCEDURE gd_copy(a$,b$)
  3954.   LOCAL a%,b%,c%,i%
  3955.   b%=1
  3956.   IF EXIST(b$)
  3957.    ALERT 3," | Datei existiert bereits... ",1,"Weiter|Abbruch",b%
  3958.   ENDIF
  3959.   IF b%=1
  3960.    OPEN "I",#1,a$         !Quell-File
  3961.    OPEN "O",#2,b$         !Ziel-File
  3962.    a%=LOF(#1)             !L
  3963. nge des Files
  3964.    b%=FRE(0)-3000         !Freier Speicher
  3965.    c%=a% MOD b%           !Rest
  3966.    DIM a|(b%)             !Speicher reservieren
  3967.    FOR i%=1 TO (a% DIV b%)!Solange alles lesen bis Rest zu klein
  3968.     BGET #1,V:a|(0),b%    !Lesen
  3969.     BPUT #2,V:a|(0),b%    !Schreiben
  3970.    NEXT i%
  3971.    BGET #1,V:a|(0),c%     !Rest lesen
  3972.    BPUT #2,V:a|(0),c%     !Rest schreiben
  3973.    CLOSE
  3974.    ERASE a|()
  3975.   ENDIF
  3976. RETURN
  3977. lug_copy1()                                                    GFA-Util
  3978. Autor: 
  3979. ,Ulli Gruszka @ DO
  3980. PROCEDURE ug_copy1(quell_datei$,ziel_datei$)
  3981.  LOCAL laenge%,frei%,adresse%,puffer%,wieoft%,rest%
  3982.  OPEN "I",#1,quell_datei$             ! Quelldatei 
  3983. ffnen, um die L
  3984.  laenge%=LOF(#1)                      ! des Files zu ermitteln,
  3985.  CLOSE #1                             ! und wieder schlie
  3986.  frei%=MALLOC(-1)                     ! gr
  3987. ten freien Speicherblock merken
  3988.  IF frei%>laenge%                     ! *Wenn m
  3989. glich, alles in einem Rutsch*
  3990.    adresse%=MALLOC(laenge%)           ! Speicher anfordern und die Quelldatei
  3991.    BLOAD quell_datei$,adresse%        ! an die erhaltene 
  3992. 'Adresse laden.
  3993.    BSAVE ziel_datei$,adresse%,laenge% ! Diesen Bereich jetzt abspeichern,
  3994.    ~MFREE(adresse%)                   ! und den Speicher wieder freigeben.
  3995.  ELSE                                 ! *ansonsten st
  3996. ckweise kopieren*
  3997.    puffer%=MALLOC(frei%)              ! das holen, was noch frei ist
  3998.    wieoft%=laenge% DIV frei%          ! Anzahl der Schreib/Lesevorg
  3999.    rest%=laenge% MOD frei%            ! eventuellen Rest der Datei merken
  4000.    OPEN "I",#1,quell_datei$           ! Quelldatei 
  4001. ffnen
  4002.    OPEN "O",#2,ziel_datei$            ! Zieldatei anlegen
  4003.    FOR i%=1 TO wieoft%                ! Schleifchen binden
  4004.      BGET #1,puffer%,frei%            ! in den Puffer lesen
  4005.      BPUT #2,puffer%,frei%            ! aus dem Puffer schreiben
  4006.    NEXT i%
  4007.    IF rest%                           ! *jetzt den wahrscheinlichen Dateirest*
  4008.      BGET #1,puffer%,rest%            ! in den Puffer lesen, und
  4009.      BPUT #2,puffer%,rest%            ! aus dem Puffer schreiben
  4010.    ENDIF
  4011.    CLOSE #2
  4012.    CLOSE #1
  4013.    ~MFREE(puffer%)
  4014.  ENDIF
  4015. RETURN
  4016. lug_copy2()                                                    GFA-Util
  4017. Autor: 
  4018. ,Ulli Gruszka @ DO
  4019. PROCEDURE ug_copy2(quell_datei$,ziel_datei$)
  4020. LOCAL laenge%,adresse%
  4021.   OPEN "I",#1,quell_datei$           ! Quelldatei 
  4022. ffnen, um die L
  4023.   laenge%=LOF(#1)                    ! des Files zu ermitteln,
  4024.   CLOSE #1                           ! und wieder schlie
  4025.   adresse%=MALLOC(laenge%)           ! Speicher anfordern und die Quelldatei
  4026.   BLOAD quell_datei$,adresse%        ! an die erhaltene 
  4027. 'Adresse laden.
  4028.   BSAVE ziel_datei$,adresse%,laenge% ! Diesen Bereich jetzt abspeichern,
  4029.   ~MFREE(adresse%)                   ! und den Speicher wieder freigeben.
  4030. RETURN
  4031. lget_alabel$()                                                 GFA-Util
  4032. Autor: 
  4033. 0Gregor Duchalski @ DO
  4034. ' Disknamen lesen
  4035. > FUNCTION get_alabel$(a&)
  4036.   CHDRIVE a&
  4037.   ~FSETDTA(BASEPAGE+128)              ! DTA setzen
  4038.   a%=FSFIRST("*.*",8)                 ! nur DISKNAME lesen
  4039.   a$=CHAR{BASEPAGE+158}               ! D_NAME lesen
  4040.   IF a%=-33                           ! wenn kein DISKNAME auf Disk
  4041.    a$=""                              ! A$ auf Leerstring setzen
  4042.   ENDIF
  4043.   RETURN a$
  4044. ENDFUNC
  4045. lset_alabel()                                                  GFA-Util
  4046. Autor: 
  4047. 0Gregor Duchalski @ DO
  4048. ' Disknamen schreiben...
  4049. > PROCEDURE set_alabel(a&,a$)
  4050.   CHDRIVE a&
  4051.   a$=LEFT$(a$,8)+CHR$(0)             ! dem Namen Nullbyte anh
  4052.   a%=
  4053.  (60,L:V:a$,8)             ! Datei anlegen
  4054.   IF a%>0                            ! wenn Datei angelegt
  4055.  (62,a%)                    ! Datei schlie
  4056.  (67,L:V:a$,1,8)            ! Datei in DISKNAMEN umbennen
  4057.   ENDIF
  4058. RETURN
  4059. lmain_path$                                                    GFA-Util
  4060. Autor: 
  4061. 0Gregor Duchalski @ DO
  4062. ' Ermittelt den aktuellen Pfad...
  4063. pfad$=CHR$(
  4064.  (25)+65)+":"+DIR$(0)+"\"
  4065. lback_up()                                                     GFA-Util
  4066. Autor: Peter Harder @ NF
  4067. PROCEDURE back_up(pfad$,ext$)
  4068. ndert bei einer bestehenden Datei die Extension
  4069.   ' Aufrufbeispiel: ordner$=@ordner_holen$("C:\WORDPLUS\BRIEF.DOC","BAK")
  4070.   LOCAL b_pfad$
  4071.   IF EXIST(pfad$)                     ! Backup 
  4072. berhaupt erforderlich?
  4073.     IF RIGHT$(pfad$,4)<>"."+ext$      ! Originalfile mit gleicher Extension?
  4074.       b_pfad$=pfad$
  4075.       @set_extension(ext$,b_pfad$) !VAR-1
  4076.       IF EXIST(b_pfad$)               ! Falls vorhanden
  4077.         
  4078. $KILL b_pfad$                  ! altes Backup l
  4079. schen
  4080.       ENDIF
  4081.       NAME pfad$ AS b_pfad$           ! und Filename 
  4082. ndern
  4083.     ENDIF
  4084.   ENDIF
  4085. RETURN
  4086. lget_new_file$()                                               GFA-Util
  4087. Autor: Peter Harder @ NF
  4088. FUNCTION get_new_file$(ordner$,such$)
  4089.   ' Gibt bei mehreren g
  4090. ltigen Dateien die mit
  4091.   ' der gr
  4092. ten Versionsnummer zur
  4093.   ' Aufrufbeispiel: pfad$=@get_new_file$("C:\QULLCODE","\ERGO_???.GFA"
  4094.   ' pfad$ enth
  4095. lt anschlie
  4096. end z.B. "C:\QUELLCODE\ERGO_235.GFA"
  4097.   LOCAL file$,gr_file$,fehler&
  4098.   ~FSETDTA(BASEPAGE+128)                   ! Setzen der Disktransferadresse
  4099.   fehler&=FSFIRST(ordner$+such$,&X100011)  ! Dateisuche ohne Ordner
  4100.   WHILE fehler&=FALSE
  4101.     file$=CHAR{BASEPAGE+158}
  4102.     IF file$>gr_file$
  4103.       SWAP file$,gr_file$
  4104.     ENDIF
  4105.     fehler&=FSNEXT()
  4106.   WEND
  4107.   RETURN ordner$+"\"+gr_file$
  4108. ENDFUNC
  4109. lordner_holen$()                                               GFA-Util
  4110. Autor: Peter Harder @ NF
  4111. FUNCTION ordner_holen$(pfad$)
  4112.   ' Aufrufbeispiel: ordner$=@ordner_holen$("C:\WORDPLUS\BRIEF.DOC")
  4113.   ' ordner$ enth
  4114. lt dann "C:\WORDPLUS")
  4115.   IF INSTR(pfad$,"\")>1
  4116.     RETURN LEFT$(pfad$,RINSTR(pfad$,"\")-1)
  4117.   ELSE IF LEN(pfad$)=2 AND RIGHT$(pfad$)=":"
  4118.     RETURN pfad$
  4119.   ELSE
  4120.     RETURN CHR$(
  4121.  (25)+65)+":"+DIR$(0)
  4122.   ENDIF
  4123. ENDFUNC
  4124. ldatei_holen$()                                                GFA-Util
  4125. Autor: Peter Harder @ NF
  4126. FUNCTION datei_holen$(pfad$)
  4127.   ' Aufrufbeispiel: datei$=@datei_holen$("C:\WORDPLUS\BRIEF.TXT")
  4128.   ' datei$ enth
  4129. lt dann "BRIEF.TXT")
  4130.   IF pfad$<>""
  4131.     RETURN MID$(pfad$,RINSTR(pfad$,"\")+1)
  4132.   ELSE
  4133.     RETURN ""
  4134.   ENDIF
  4135. ENDFUNC
  4136. ldrive_blink()                                                 GFA-Util
  4137. Autor: 
  4138. 0Gregor Duchalski @ DO
  4139. ' Blinken der Laufwerkslampen...
  4140. ' a&=Laufwerk 1 oder 2, b&=Wie oft blinken, c&=L
  4141. nge des Blinkens
  4142. > PROCEDURE drive_blink(a&,b&,c&)
  4143.   FOR i&=1 TO b&
  4144. %XBIOS(29,5-a&)
  4145.    PAUSE c&
  4146. %XBIOS(30,2+a&)
  4147.    PAUSE c&
  4148.   NEXT i&
  4149. RETURN
  4150. lfilename_ext$()                                               GFA-Util
  4151. Autor: 
  4152.   @ AC3
  4153. ' Filename 'formatieren'
  4154. ' aus TEST.TXT     wird TEST    .TXT
  4155. ' aus 12345678.TXT   "  12345678.TXT
  4156. > FUNCTION filename_ext$(datei$)      ! File und Extender extrahieren
  4157. anzeige$=datei$                       ! Name ermitteln
  4158. IF anzeige$<>""
  4159.   pos|=INSTR(anzeige$,".")            ! Punkt im Namen?
  4160.   IF pos|                             ! Acht Zeichen vor Punkt?
  4161. 2' #UMBRUCH ANFANG!
  4162.     anzeige$=LEFT$(anzeige$,pos|-1)+SPACE$(8-
  4163.     LEN(LEFT$(anzeige$,pos|-1)))+MID$(anzeige$,pos|)
  4164. 0' #UMBRUCH ENDE!
  4165.   ENDIF
  4166.   anzeige$=anzeige$+SPACE$(12-LEN(anzeige$))
  4167. ENDIF
  4168. RETURN anzeige$
  4169. ENDFUNC
  4170. lset_extend$()                                                 GFA-Util
  4171. Autor: 
  4172. /Michael Wedding @ AC3
  4173. ' Extender zwangsweise(!) vorgeben.
  4174. ' In extend$ wird der Extender (ohne Punkt!!!) 
  4175. bergeben,
  4176. ' in select$ der [Pfad- und] Filename.
  4177. ' Bei dat$=@set_extend$("EXT","FILENAME") oder
  4178. '     dat$=@set_extend$("EXT","FILENAME.---")
  4179. ' wird demnach "FILENAME.EXT" zur
  4180. ckgegeben.
  4181. /Michael Wedding, Apr 11 1993
  4182. > FUNCTION set_extend$(extend$,select$)
  4183.   IF RINSTR(MID$(select$,RINSTR(select$,"\")),".")
  4184.     select$=LEFT$(select$,PRED(RINSTR(select$,".")))
  4185.   ENDIF
  4186.   RETURN select$+"."+extend$
  4187. ENDFUNC
  4188. lset_extension()                                               GFA-Util
  4189. Autor: Peter Harder @ NF
  4190. PROCEDURE set_extension(ext$,VAR pfad$)
  4191.   ' Aufrufbeispiel: @set_extension("DOC",brief$)
  4192.   ' Bei der Variablen brief$ wird die Extension "DOC" durch
  4193.   ' anh
  4194. ngen oder 
  4195. berschreiben erzwungen
  4196.   IF INSTR(@datei_holen$(pfad$),".")=0
  4197.     pfad$=pfad$+"."+ext$                          ! Extension anh
  4198.   ELSE
  4199.     pfad$=LEFT$(pfad$,RINSTR(pfad$,"."))+ext$     ! Extension 
  4200. berschreiben
  4201.   ENDIF
  4202. RETURN
  4203. lstr_cut_file$()                                               GFA-Util
  4204. Autor: 
  4205. *Ulf Dunkel @ CLP
  4206. Das ist wieder so ein allgemeines Problem. "Wie stelle ich den Pfad
  4207. dar?" Was passiert in einem Fenster, wenn der Pfad l
  4208. nger ist als die
  4209. Titelzeile des Fensters? Es wird nur noch der sichtbare LEFT$() von
  4210.   gezeigt. V
  4211. llig in Ordnung so, niemand quakt deswegen.
  4212. Was passiert im Atari-DESKTOP in den Dialogen? Die neueren haben
  4213. wirklich wahnsinnig originelle <- und -> Buttons. Damit kannst Du
  4214. rlich Dein Pfad-TEXT-Objekt einfach weiterscrollen. Halte ich f
  4215. ndlich und unn
  4216.  , ergo! (und lat
  4217. rnich auch meine Programme) schneiden
  4218. einfach den redundanten Teil eines Pfadstrings in der Darstellung ab.
  4219. Was ist redundant an einem Pfad? Die ersten Ordner, nicht die
  4220. letzten.
  4221. Den Pfad merkst Du Dir doch 
  4222. blicherweise in einer Variablen. Ich
  4223. hoffe, da
  4224.  niemand seine Pfadstrings 
  4225. d in den 
  4226. #GEM-Objekten
  4227. speichert und hofft, da
  4228.  sie dort immer korrekt liegenbleiben.
  4229. Mit einer v
  4230. llig banalen Routine kann jeder seine Pfad-Darstellungen
  4231. so beschneiden, da
  4232.  der Anwender immer noch genug von der Pfad-
  4233. Information zu sehen bekommt. Z.B. so (Schon wieder rupft er sein
  4234. MAIL Service auseinander):
  4235. ' MODUL STR
  4236. ' =========
  4237. FUNCTION str_cut_file$(file$,long&,path_only!)
  4238.   ' INTENT: gibt einen auf long& verk
  4239. rzten Dateinamen zur
  4240. ck, wobei die Lauf-
  4241.   '         werksbezeichnung immer intakt bleibt und der rechte Teil des Datei-
  4242.   '         namens vorrangig behandelt wird, z.B. "A:\..\FILENAME.EXT"
  4243.   '         Wer will, kann nat
  4244. rlich auch DREI Punkte zeigen. :-/
  4245.   ' RETURN: Originalstring oder gem. INTENT verk
  4246. rzter String.
  4247.   ' EXTERN file$        !Wirklicher Dateipfad und -Name
  4248.   ' EXTERN long&        !Gew
  4249. nschte Anzeige-L
  4250.   ' EXTERN path_only!   !TRUE = Nur Pfad, keinen Dateinamen!!
  4251.   LOCAL here&           !Zeiger
  4252.   LOCAL drive$          !Laufwerk
  4253.   IF path_only!
  4254.     IF INSTR(file$,"\")=0 OR LEN(file$)<3
  4255.       RETURN ""
  4256.     ENDIF
  4257.     file$=LEFT$(file$,RINSTR(file$,"\"))  !Dateinamen abschneiden
  4258.   ENDIF
  4259.   SELECT LEN(file$)
  4260.   CASE  TO 0            !Nix 
  4261.     RETURN ""
  4262.   CASE 1 TO long&       !Max.-L
  4263. nge sowieso nicht erreicht?
  4264.     RETURN file$
  4265.   ENDSELECT
  4266.   here&=INSTR(file$,"\")
  4267.   drive$=LEFT$(file$,here&)+"..\"
  4268.   file$=MID$(file$,SUCC(here&))
  4269.   WHILE LEN(file$)+LEN(drive$)>long&
  4270.     here&=INSTR(file$,"\")
  4271.     IF here&
  4272.       file$=MID$(file$,SUCC(here&))
  4273.     ENDIF
  4274.   WEND
  4275.   RETURN drive$+file$
  4276. ENDFUNC
  4277. lpfad_format$()                                                GFA-Util
  4278. Autor: Frank R
  4279. ger @ OS2
  4280. ' 'pfad_format$()' formatiert einen gegebenen Pfad (+Dateiname) auf
  4281. ' eine vorgegebene L
  4282. nge (f&)! Beispiel: Aus
  4283. ' @pfad_format$("G:\DFUE\CAT\LISTEN\LOCAL\OS-33.LST",30) wird:
  4284. ' "G:\...T\LISTEN\LOCAL\OS-33.LST"!
  4285. ' Dabei geht die Funktion davon aus, da
  4286.  es sich um einen absoluten
  4287. ' Pfad inkl. Laufwerks-Angabe handelt!
  4288. ' Die ersten drei Zeichen werden immer ausgegeben!
  4289. 2' #UMBRUCH ANFANG!
  4290. DEFFN pfad_format$(p$,f&)=STRING$(-(LEN(p$)>f&),
  4291. LEFT$(p$,3)+"...")+RIGHT$(p$,f&+6*(LEN(p$)>f&))
  4292. 0' #UMBRUCH ENDE!
  4293. lfile_to_rsc$()                                                GFA-Util
  4294. Autor: 
  4295.   @ KR
  4296. > FUNCTION file_to_rsc$(pfad$,rsc_txt_len|)
  4297.   REM Diese Funktion verk
  4298. rzt einen einkommenden Pfad, wenn er l
  4299.   REM als das RSC-Text-Objekt ist, in das er eingetragen wird.
  4300.   REM So wird z.B. aus "H:\BASIX\VESAL\OTHER\INDEXEDI\DUMMY.TXT" bei
  4301.   REM einer Resourcetextl
  4302. nge von z.B. 30 Zeichen
  4303.   REM "H:\...\INDEXEDI\DUMMY.TXT"
  4304.   LOCAL a$,b$,p|
  4305.   IF LEN(pfad$)>rsc_txt_len|     ! Pfadl
  4306. nge gr
  4307. er als RSC-TXT-L
  4308.     '
  4309.     a$=LEFT$(pfad$,3)+"..."      ! dann die ersten 3 Buchstaben nach a$
  4310.     b$=RIGHT$(pfad$,LEN(pfad$)-7)      ! der Rest nach b$
  4311.     '
  4312.     WHILE LEN(a$)+LEN(b$)>rsc_txt_len| !
  4313.       p|=INSTR(pfad$,"\")              ! Pointer auf "\"
  4314.       b$=RIGHT$(pfad$,LEN(pfad$)-p|+1) ! String ab Pointer nach b$
  4315.       delete(1,p|+1,pfad$)             ! Pfad verk
  4316.     WEND
  4317.     '
  4318.     RETURN a$+b$         ! R
  4319. ckgabewert: Verk
  4320. rzter String
  4321.     '
  4322.   ELSE                   ! Pfadl
  4323. nge kleiner/gleich RSC-TXT-L
  4324.     '
  4325.     RETURN pfad$         ! R
  4326. ckgabewert: Eingangsstring
  4327.     '
  4328.   ENDIF
  4329. ENDFUNC
  4330. lDatum und Uhrzeit                                             GFA-Util
  4331. Hier steht noch nix!
  4332. lProzessfunktionen                                             GFA-Util
  4333. lPEXEC-Grundlagen                                              GFA-Util
  4334. Autor: Roland Skuplik @ DO2
  4335. Da die Feinheiten von 
  4336. %Pexec immer noch nicht allgemein bekannt sind,
  4337. fasse ich mal zusammen, was mir dazu einf
  4338. %Pexec() f
  4339. r GFA-BASIC-Programmierer:
  4340. fehler% = 
  4341.  (pexec&, mode&, ...)
  4342. IF fehler% = -32
  4343. %Pexec-Modus mode& gibt es in dieser 
  4344.  -Version nicht!
  4345.   ... anderen 
  4346. %Pexec-Modus benutzen ...
  4347. ENDIF
  4348. IF fehler%
  4349.   pling
  4350.   IF fehler% < 0
  4351.     "Betriebssystem meldet Fehler "+STR$(fehler%)+" beim Programmstart."
  4352.   ELSE
  4353.     fehler& = fehler%  ! Nur die niederwertigen 16 Bit!
  4354.     IF NOT magic! AND fehler& = -1 OR fehler& = -69
  4355.       ' Bis TOS 1.02 wird mit 0 beendet. :-(
  4356.       "Programm mit Bomben abgest
  4357. rzt."
  4358.     ELSE IF NOT magic! AND fehler& = -32 OR fehler& = -68
  4359.       "Programm mit ^C abgebrochen."
  4360.     ELSE
  4361.       "Programm endete mit Fehler "+STR$(fehler&)+"."
  4362.     ENDIF
  4363.   ENDIF
  4364. ENDIF
  4365. lSpeicherverwaltung                                            GFA-Util
  4366. lmxalloc()                                                     GFA-Util
  4367. Autoren: 
  4368. 0Gregor Duchalski @ DO, 
  4369. 1Oliver Schildmann @ LU
  4370. FUNCTION mxalloc(size%,art&)
  4371.   $F%
  4372.   ' Ruft 
  4373. 'Mxalloc() statt 
  4374. &Malloc() auf, wenn es die 
  4375.  -Version erlaubt...
  4376.   ' m&: 0 = Nur aus dem ST-RAM.
  4377.   '     1 = Nur aus dem TT-RAM.
  4378.   '     2 = Egal, aber lieber aus dem ST-RAM.
  4379.   '     3 = Egal, aber lieber aus dem TT-RAM.
  4380.   ' Bit 5 = GLOBAL   \
  4381.   ' Bit 6 = SUPER    -MTOS
  4382.   ' Bit 7 = READABLE /
  4383.   ' --------------------------------------------------
  4384.   ret_value%=
  4385.  (68,L:size%,art&) ! MXALLOC
  4386.   IF ret_value%=-32                ! MXALLOC nicht vorhanden (altes TOS)!
  4387.    IF art&=1                       ! Wenn explizit TT-RAM angefordert wurde
  4388.     ret_value%=0                   ! eine 0 
  4389. bergeben, da kein freies RAM
  4390.    ELSE                            ! Ansonsten ganz normal ST-RAM mit
  4391.     ret_value%=
  4392.  (72,L:size%)  ! (altem) MALLOC-Aufruf allozieren.
  4393.    ENDIF
  4394.   ENDIF
  4395.  RETURN ret_value%              ! Und Anfangsadresse oder 0 
  4396. bergeben
  4397.  ' Ist ein 
  4398.  -Aufruf nicht vorhanden, so wird -32 zur
  4399. ckgegeben.
  4400.  ' Ausserdem sollte 0 zur
  4401. ckgegeben werden, wenn explizit TT-RAM
  4402.  ' angefordert wurde, aber, wg. ST, keines vorhanden ist.
  4403.  ' Auch und gerade MiNT-Aufrufe sollten mit R
  4404. ckgabewert 
  4405. berpr
  4406.  ' werden!
  4407. ENDFUNC
  4408. lSystemfunktionen                                              GFA-Util
  4409. Hier steht noch nix!
  4410. lVerzeichnisfunktionen                                         GFA-Util
  4411.   (Freien Platz auf Laufwerk/Diskette ermitteln)
  4412. ldiskinfo()                                                    GFA-Util
  4413. Autor: 
  4414.   @ XYZ
  4415. ' Freien Platz auf Laufwerk/Diskette ermitteln...
  4416. free%=@diskinfo("F")
  4417. PRINT free%
  4418. > FUNCTION diskinfo(drv$)
  4419.   LOCAL drv&,ret&
  4420.   drv&=ASC(drv$)-64
  4421.   INLINE diskinfo%,24
  4422.   ret&=
  4423.  (54,L:diskinfo%,drv&)
  4424.   RETURN {diskinfo%+8}*{diskinfo%+12}*{diskinfo%}
  4425. ENDFUNC
  4426. lZeichenweise Ein-/Ausgabe                                     GFA-Util
  4427. Hier steht noch nix!
  4428. lVDI                                                           GFA-Util
  4429. lAttributfunktionen                                            GFA-Util
  4430. Hier steht noch nix!
  4431. lAusgabefunktionen                                             GFA-Util
  4432. lv_gtext()                                                     GFA-Util
  4433. Autor: 
  4434. -David Reitter @ WI2
  4435. Also, was ich hier habe, ist ein alternativer v_gtext()-Aufruf, der
  4436. einen Textstring mit 
  4437. 'v_gtext ausgibt. Die Daten werden dabei per
  4438. Assembler in das INTIN-Feld geschrieben.
  4439. ' Etwas schnellere 
  4440.  -Text-Ausgabe
  4441. ' deutlich schneller im Interpreter
  4442. PROCEDURE vg_init
  4443.   DIM vdi%(4)
  4444.   vdi%(0)=CONTRL
  4445.   vdi%(1)=INTIN
  4446.   vdi%(2)=INTOUT
  4447.   vdi%(3)=PTSIN
  4448.   vdi%(4)=PTSOUT
  4449.   ' der kompilierte Assemblercode:
  4450.   INLINE v_gtext_adr%,64
  4451. RETURN
  4452. ' und der Aufruf:
  4453. ~C:v_gtext_adr%(L:*ausgabestring$,80,100,L:V:vdi%(0))
  4454. Hier der Assemblercode:
  4455. ; V_GTEXT                 Volker Hemsen             Oktober 1991
  4456. #GEM-Text f
  4457. r GFA-Basic  (schnelles TEXT X,Y,A$)
  4458. ; Der 
  4459.  -Textaufruf wird in GFA-Basic sehr stark abgebremst.
  4460. ; Mit dieser kleinen Routine ist es m
  4461. glich durch 
  4462. bergabe einer
  4463. ; String-Deskriptor-
  4464. 'Adresse einen Text auszugeben.
  4465. ; Wenn man die X-Koordinate auf ein 8faches legt, erzielt man
  4466. ; ebenfalls einen enormen Geschwindigkeitszuwachs.
  4467. ; Noch schneller gehts mit diversen 
  4468.  -Patches, z.B. Quick ST
  4469. ; Turbo ST, 
  4470. $NVDI usw.
  4471. ; Aufruf:
  4472. ;          ~C: adr%( L:*A$ , X& , Y& , L:VDI_BLOCK% )
  4473. ; (siehe V_GTEXT.LST)
  4474. str_des         EQU 4           ;*A$
  4475. x               EQU 8
  4476. y               EQU 10
  4477. vdi_block       EQU 12
  4478. contrl          EQU 0
  4479. intin           EQU 4
  4480. ptsin           EQU 8
  4481. intout          EQU 12
  4482. ptsout          EQU 16
  4483.                 movea.l vdi_block(SP),A0
  4484.                 move.l  A0,D1           ;f
  4485. r TRAP
  4486.                 movea.l ptsin(A0),A1    ;ptsin
  4487.                 move.l  x(SP),(A1)      ;xy setzen
  4488.                 movea.l intin(A0),A2    ;intin
  4489.                 movea.l (A0),A0         ;contrl
  4490.                 move.l  #$080002,(A0)   ;opcode und anz_ptsin setzen
  4491.                 move.l  str_des(SP),D0  ;str_des
  4492.                 tst.l   D0
  4493.                 ble.s   ende
  4494.                 movea.l D0,A1
  4495.                 move.w  4(A1),D0        ;str_len
  4496.                 tst.w   D0
  4497.                 ble.s   ende
  4498.                 move.w  D0,6(A0)        ;anz_intin
  4499.                 movea.l (A1),A1         ;str_adr
  4500. loop:           clr.b   (A2)+           ;Zeichen 
  4501. bergeben
  4502.                 move.b  (A1)+,(A2)+
  4503.                 subq.w  #1,D0
  4504.                 bgt.s   loop
  4505.                 moveq   #$73,D0
  4506.                 trap    #2
  4507. ende:           rts
  4508.                 END
  4509. Diese Routine gab's irgendwo mal als Dreingabe. Man kann sie noch schneller
  4510. machen, indem man
  4511.                 subq.w  #1,D0
  4512.                 bgt.s   loop
  4513. durch einen
  4514.                 dbra D0,loop
  4515. ersetzt, denke ich mir mal (nicht getestet). Vorher mu
  4516.  dann aber noch ein
  4517.                 subq.w  #1,D0
  4518. rein.
  4519. gale benutze ich eine Ass-Routine, die die TABs automatisch (mit
  4520. einem beliebigen Zeichen auf beliebige TAB-Positionen) expandiert und
  4521. gleichzeitig die Stringl
  4522. nge auf z.B. Fensterbreite begrenzt. Dabei
  4523. beginnt sie erst ab einer bestimmten Position im String (f
  4524. r den
  4525. horziontalen Slider im Fenster), beachtet aber eventuell hiervor
  4526. vorkommende TABs. Das ganze ist nat
  4527. rlich viel schneller als ein
  4528. Durchsuchen des ganzen Strings nach TABs in GFA...
  4529. lAuskunftsfunktionen                                           GFA-Util
  4530. lvq_chcells()                                                  GFA-Util
  4531. Autor: 
  4532.   @ XYZ
  4533. ' Liefert Anzahl der Spalten und Zeilen des Textbildschirms zur
  4534. ' (LINE-A 'FREI')
  4535. 'WICHTIG bei 'Aufl
  4536. sungsunabh
  4537. ngiger' Programmierung!
  4538. ' WORK_OUT von GFA Arbeitet SEHR Fehlerhaft, da nur die ST-
  4539. ' Aufl
  4540. sungen unterst
  4541. tzt werden.
  4542. > PROCEDURE 
  4543. *vq_chcells(VAR spalten%,zeilen%)
  4544.   CONTRL(1)=0
  4545.   CONTRL(2)=0
  4546.   CONTRL(5)=1
  4547.   CONTRL(6)=V~H
  4548.   VDISYS 5
  4549.   spalten%=INTOUT(1)
  4550.   zeilen%=INTOUT(0)
  4551. RETURN
  4552. lEingabefunktionen                                             GFA-Util
  4553. Hier steht noch nix!
  4554. lEscapefunktionen                                              GFA-Util
  4555. Hier steht noch nix!
  4556. lKontrollfunktionen                                            GFA-Util
  4557. Hier steht noch nix!
  4558. lRasterfunktionen                                              GFA-Util
  4559. lvdi_copy                                                      GFA-Util
  4560. Autor: 
  4561. -David Reitter @ WI2
  4562. Also gut. Hier mal eine Routine (das ist die Prozedur vdi_copy) zum
  4563. Kopieren von Bildschirmbereichen. Aufrufargumente sind die
  4564. Koordinaten des linken oberen Punktes des Quellbereiches, die des
  4565. rechten unteren Punktes und dann die Zielkorrdinaten (links oben).
  4566. Recht flott. Den Rest mu
  4567. t Du selbst erledigen, er h
  4568. ngt von anderen
  4569. Variablen (Fensterbereichskoordinaten, Scrollweite/Buchstabenh
  4570. ab. Du mu
  4571. t beim normalen Kopieren prinzipiell alles um ein Zeichen
  4572. nach oben versetzen (beginne bei der 2. Zeile im Fenster), dann die
  4573. unterste Zeile l
  4574. schen (einfach PBOX) und die n
  4575. chste, neue Zeile
  4576. hinzuf
  4577. gen. No problem!
  4578. chst der Initbereich....
  4579. psrcmfdb%=MALLOC(56)             ! Vorbereitung f
  4580. r vdi_copy()
  4581. IF psrcmfdb%<1
  4582.   ALERT 3,"Fehler bei der Speicher-|reservierung von 56 Bytes !",1,"Abbruch",o%
  4583.   EDIT
  4584. ENDIF
  4585. pdesmfdb%=psrcmfdb%+20
  4586. (pxyarray%=pdesmfdb%+20
  4587. > PROCEDURE vdi_copy(x1,y1,x2,y2,x3,y3)
  4588.   LOCAL v_width,v_height
  4589.   v_width=@width(x1,x2)
  4590.   v_height=@height(y1,y2)
  4591.   make_zero_mfdb(psrcmfdb%)
  4592.   make_zero_mfdb(pdesmfdb%)
  4593. 2' #UMBRUCH ANFANG!
  4594. ,make_xyarray(
  4595. (pxyarray%,x1,y1,x2,y2,x3,y3,
  4596.   x3+SUB(v_width,1),y3+SUB(v_height,1))
  4597. 0' #UMBRUCH ENDE!
  4598.   hide_mouse
  4599. )vro_cpyfm(V~H,3,
  4600. (pxyarray%,psrcmfdb%,pdesmfdb%)
  4601.   show_mouse
  4602. RETURN
  4603. > FUNCTION width(x0,x1)
  4604.   RETURN ADD(SUB(x1,x0),1)
  4605. ENDFUNC
  4606. > FUNCTION height(y0,y1)
  4607.   RETURN ADD(SUB(y1,y0),1)
  4608. ENDFUNC
  4609. > PROCEDURE hide_mouse
  4610.   '  
  4611. (v_hide_c(V~H)
  4612.   ~GRAF_MOUSE(256,0)
  4613. RETURN
  4614. > PROCEDURE show_mouse
  4615.   '  
  4616. (v_show_c(V~H,1)
  4617.   ~GRAF_MOUSE(257,0)
  4618. RETURN
  4619. > PROCEDURE make_zero_mfdb(pmfdb%)
  4620.   LONG{pmfdb%}=0
  4621.   LONG{ADD(pmfdb%,4)}=0
  4622.   LONG{ADD(pmfdb%,8)}=0
  4623.   LONG{ADD(pmfdb%,12)}=0
  4624.   LONG{ADD(pmfdb%,16)}=0
  4625. RETURN
  4626. > PROCEDURE 
  4627. ,make_xyarray(
  4628. (pxyarray%,xq0,yq0,xq1,yq1,xz0,yz0,xz1,yz1)
  4629.   WORD{
  4630. (pxyarray%}=xq0
  4631.   WORD{ADD(
  4632. (pxyarray%,2)}=yq0
  4633.   WORD{ADD(
  4634. (pxyarray%,4)}=xq1
  4635.   WORD{ADD(
  4636. (pxyarray%,6)}=yq1
  4637.   WORD{ADD(
  4638. (pxyarray%,8)}=xz0
  4639.   WORD{ADD(
  4640. (pxyarray%,10)}=yz0
  4641.   WORD{ADD(
  4642. (pxyarray%,12)}=xz1
  4643.   WORD{ADD(
  4644. (pxyarray%,14)}=yz1
  4645. RETURN
  4646. > PROCEDURE 
  4647. )vro_cpyfm(handle,wr_mode,
  4648. (pxyarray%,psrcmfdb%,pdesmfdb%)
  4649.   CONTRL(0)=109
  4650.   CONTRL(1)=4
  4651.   CONTRL(2)=0
  4652.   CONTRL(3)=1
  4653.   CONTRL(4)=0
  4654.   CONTRL(6)=handle
  4655.   LONG{ADD(CONTRL,14)}=psrcmfdb%
  4656.   LONG{ADD(CONTRL,18)}=pdesmfdb%
  4657.   INTIN(0)=wr_mode
  4658.   BMOVE 
  4659. (pxyarray%,PTSIN,16
  4660.   VDISYS
  4661. RETURN
  4662. lSauberes (S)GET und (S)PUT                                    GFA-Util
  4663. $sget ist wahlweise einmal als Function, einmal als Procedure drin.
  4664. Die Variable xbios3! wird bei mir je nach TOS-Version und einiger
  4665. abgefragter R
  4666. ckgabewerte vorbelegt. Die Vorgehensweise bringt etwas
  4667. Geschwindigkeitsgewinn, ist aber wohl nicht in jedermanns Augen ganz
  4668. astrein, daher kann man sie auch rausnehmen.
  4669. RC_COPY hei
  4670. t bei mir @
  4671. (scr_copy
  4672.  einmal am Programmanfang aufgerufen werden
  4673. Die Grundroutine von @
  4674. (scr_copy stammt von 
  4675. -David Reitter. Ich habe
  4676. Sie noch ein wenig umgestrickt und @
  4677. $get$/@
  4678. #put hinzugef
  4679. gt. Peter
  4680. Harder @ NF
  4681. lSauberes SGET (als Funktion)                                  GFA-Util
  4682. Autor: Peter Harder @ NF
  4683. FUNCTION sget$
  4684.   LOCAL scr$
  4685. $sget(scr$)
  4686.   RETURN scr$
  4687. ENDFUNC
  4688. lSauberes SGET (als Prozedur)                                  GFA-Util
  4689. Autor: Peter Harder @ NF
  4690. PROCEDURE sget(VAR scr$)
  4691.   IF xbios3!=TRUE
  4692.     @
  4693. %hidem
  4694.     SGET scr$
  4695.     @
  4696. %showm
  4697.   ELSE
  4698.     scr$=@
  4699. $get$(0,0,639,399)
  4700.   ENDIF
  4701. RETURN
  4702. lSauberes SPUT (als Prozedur)                                  GFA-Util
  4703. Autor: Peter Harder @ NF
  4704. PROCEDURE sput(scr$)
  4705.   IF xbios3!=TRUE
  4706.     IF LEN(scr$)=32000
  4707.       @
  4708. %hidem
  4709.       SPUT scr$
  4710.       @
  4711. %showm
  4712.     ELSE
  4713.       ALERT 3,tos$+" Fehler bei SPUT ! ",1," Weiter ",void&
  4714.     ENDIF
  4715.   ELSE
  4716.     @
  4717. #put(0,0,scr$)
  4718.   ENDIF
  4719. RETURN
  4720. lSauberes GET (als Funktion)                                   GFA-Util
  4721. Autor: Peter Harder @ NF
  4722. FUNCTION get$(x1&,y1&,x2&,y2&)
  4723.   LOCAL get$,but&,str_laenge&
  4724.   LOCAL br&,br_word&,ho&
  4725.   br&=x2&-x1&+1
  4726.   ho&=y2&-y1&+1
  4727.   br_word&=(br&+15)/16
  4728.   str_laenge&=br_word&*ho&*vdi_planes&*2+4
  4729.   IF str_laenge&<32768 AND br&>0 AND ho&>0
  4730.     ~FRE(0)
  4731.     get$=STRING$(str_laenge&,0)    ! String vorbelegen
  4732.     WORD{V:get$}=br&         ! Breite eintragen
  4733.     WORD{V:get$+2}=ho&       ! H
  4734.     '
  4735.     @
  4736. ,make_xyarray(pxy_array%,x1&,y1&,x2&,y2&,0,0,SUB(br&,1),SUB(ho&,1))
  4737.     '
  4738.     BMOVE loesch_mfdb%,psrc_mfdb%,20  ! Screen-Quellrasterwerte l
  4739. schen
  4740.     LONG{pdes_mfdb%}=V:get$+4         ! Blockadresse String-Zielraster
  4741.     WORD{pdes_mfdb%+4}=br_word&*16    ! Breite in Pixel
  4742.     WORD{pdes_mfdb%+6}=ho&            ! H
  4743. he in Pixel
  4744.     WORD{pdes_mfdb%+8}=br_word&       ! Breite in Word
  4745.     WORD{pdes_mfdb%+12}=vdi_planes&   ! Original, wegen Farbtestversion
  4746.     '
  4747.     @
  4748. )vro_cpyfm(V~H,3,pxy_array%,psrc_mfdb%,pdes_mfdb%)
  4749.     '
  4750.   ELSE
  4751.     get$="void"
  4752.   ENDIF
  4753.   RETURN get$
  4754. ENDFUNC
  4755. lSauberes PUT (als Prozedur)                                   GFA-Util
  4756. Autor: Peter Harder @ NF
  4757. PROCEDURE put(x1&,y1&,put$)
  4758.   LOCAL but&,br&,ho&,br_word&
  4759.   IF LEN(put$)>4
  4760.     '
  4761.     ~FRE(0)
  4762.     br&=WORD{V:put$}           ! Breite holen ...
  4763.     ho&=WORD{V:put$+2}         ! ... und die H
  4764.     br_word&=(br&+15)/16
  4765.     '
  4766.     @
  4767. ,make_xyarray(pxy_array%,0,0,br&-1,ho&-1,x1&,y1&,x1&+br&-1,y1&+ho&-1)
  4768.     '
  4769.     BMOVE loesch_mfdb%,pdes_mfdb%,20  ! Screen-Zielrasterwerte l
  4770. schen
  4771.     LONG{psrc_mfdb%}=V:put$+4         ! Blockadresse String-Quellraster
  4772.     WORD{psrc_mfdb%+4}=br_word&*16    ! Breite in Pixel
  4773.     WORD{psrc_mfdb%+6}=ho&            ! H
  4774. he in Pixel
  4775.     WORD{psrc_mfdb%+8}=br_word&       ! Breite in Word
  4776.     WORD{psrc_mfdb%+12}=vdi_planes&   ! Original, wegen Farbtestversion
  4777.     '
  4778.     @
  4779. )vro_cpyfm(V~H,3,pxy_array%,psrc_mfdb%,pdes_mfdb%)
  4780.     '
  4781.   ENDIF
  4782. RETURN
  4783. lvdi_copy_init                                                 GFA-Util
  4784. Autor: Peter Harder @ NF
  4785. PROCEDURE vdi_copy_init
  4786.   ' Grundroutine von 
  4787. -David Reitter @ WI2 (Fr, 26.08.94)
  4788.   INLINE psrc_mfdb%,76
  4789.   pdes_mfdb%=psrc_mfdb%+20
  4790.   pxy_array%=pdes_mfdb%+20
  4791.   loesch_mfdb%=psrc_mfdb%+56
  4792.   vdi_planes&=LEN(BIN$(WORK_OUT(13)-1))
  4793. RETURN
  4794. lscr_copy()                                                    GFA-Util
  4795. Autor: Peter Harder @ NF
  4796. PROCEDURE scr_copy(x1&,y1&,w&,h&,x3&,y3&)
  4797.   x2&=x1&+w&-1
  4798.   y2&=y1&+h&-1
  4799. 2' #UMBRUCH ANFANG!
  4800. ,make_xyarray(pxy_array%,x1&,y1&,x2&,y2&
  4801.   ,x3&,y3&,x3&+SUB(w&,1),y3&+SUB(h&,1))
  4802. 0' #UMBRUCH ENDE!
  4803.   BMOVE loesch_mfdb%,psrc_mfdb%,20   ! bei scr_copy beide
  4804.   BMOVE loesch_mfdb%,pdes_mfdb%,20   ! mfdb loeschen
  4805. )vro_cpyfm(V~H,3,pxy_array%,psrc_mfdb%,pdes_mfdb%)
  4806. RETURN
  4807. lmake_xyarray()                                                GFA-Util
  4808. Autor: Peter Harder @ NF
  4809. PROC make_xyarray(pxy_array%,xq0&,yq0&,xq1&,yq1&,xz0&,yz0&,xz1&,yz1&)
  4810.   WORD{pxy_array%}=xq0&
  4811.   WORD{ADD(pxy_array%,2)}=yq0&
  4812.   WORD{ADD(pxy_array%,4)}=xq1&
  4813.   WORD{ADD(pxy_array%,6)}=yq1&
  4814.   WORD{ADD(pxy_array%,8)}=xz0&
  4815.   WORD{ADD(pxy_array%,10)}=yz0&
  4816.   WORD{ADD(pxy_array%,12)}=xz1&
  4817.   WORD{ADD(pxy_array%,14)}=yz1&
  4818. RETURN
  4819. lvro_cpyfm()                                                   GFA-Util
  4820. Autor: Peter Harder @ NF
  4821. PROC vro_cpyfm(handle&,wr_mode&,pxy_array%,psrc_mfdb%,pdes_mfdb%)
  4822.   CONTRL(1)=4
  4823.   CONTRL(2)=0
  4824.   CONTRL(3)=1
  4825.   CONTRL(4)=0
  4826.   CONTRL(6)=handle&
  4827.   LONG{ADD(CONTRL,14)}=psrc_mfdb%
  4828.   LONG{ADD(CONTRL,18)}=pdes_mfdb%
  4829.   INTIN(0)=wr_mode&
  4830.   BMOVE pxy_array%,PTSIN,16
  4831. %hidem
  4832.   VDISYS 109
  4833. %showm
  4834. RETURN
  4835. lCookies                                                       GFA-Util
  4836.  6.1 
  4837.  6.2 
  4838.  6.3 
  4839.  6.4 
  4840.  6.5 
  4841.  6.6 
  4842. lCookie ermitteln (nach Rosin)                                 GFA-Util
  4843. Autor: 
  4844. ,Reiner Rosin @ WI2
  4845. PROCEDURE test_cookie(kenn$,VAR flag,wert)
  4846.   REM
  4847.   REM
  4848.   REM  Modul: test_cookie
  4849.   REM
  4850.   REM V1.0 vom 21.11.90
  4851.   REM
  4852.   REM Testet, ob der angegebene Cookie im Cookie-Jar installiert ist.
  4853.   REM R
  4854. ckgabe: flag =  0 - nicht installiert
  4855.   REM      oder flag = -1 - installiert, wert = Parameter des Cookie
  4856.   REM
  4857.   LOCAL cookie,such_kennung,kennung
  4858.   such_kennung=CVL(kenn$)
  4859.   cookie=LPEEK(&H5A0)
  4860.   IF cookie<>0
  4861.     REPEAT
  4862.       kennung=LPEEK(cookie)
  4863.       wert=LPEEK(cookie+4)
  4864.       ADD cookie,8
  4865.     UNTIL kennung=such_kennung OR kennung=0
  4866.     IF kennung=0
  4867.       flag=0
  4868.       wert=0
  4869.     ELSE
  4870.       flag=-1
  4871.     ENDIF
  4872.   ELSE
  4873.     flag=0
  4874.     wert=0
  4875.   ENDIF
  4876. RETURN
  4877. lCookie ermitteln (nach R
  4878. ger)                                 GFA-Util
  4879. Autor: Frank R
  4880. ger @ OS2
  4881. FUNCTION get_cookie(id$,VAR value%)
  4882.   $F%
  4883.   ' Sucht den Cookie mit der Kennung id$. Wird er gefunden, wird TRUE
  4884.   ' zur
  4885. ckgegeben und in value% der Wert des 
  4886.   LOCAL a%,a$
  4887.   a%=LPEEK(&H5A0)
  4888.   IF a%=0
  4889.     RETURN FALSE
  4890.   ENDIF
  4891.   DO WHILE {a%}<>0
  4892.     a$=MKL$({a%})
  4893.     ADD a%,8
  4894.   LOOP UNTIL a$=id$
  4895.   IF a$=id$
  4896.     value%={SUB(a%,4)}
  4897.     RETURN TRUE
  4898.   ENDIF
  4899.   RETURN FALSE
  4900. ENDFUNC
  4901. lCookie ermitteln (nach Dunkel)                                GFA-Util
  4902. Autor 
  4903. *Ulf Dunkel @ CLP
  4904. PROCEDURE sys_cookie_chk
  4905.   ' GLOBAL mint!                !TRUE=MiNT-Cookie gefunden, MiNT l
  4906.   ' GLOBAL vscr!                !TRUE=VSCR installiert
  4907.   ' GLOBAL vscr_adr%            !
  4908. 'Adresse des VSCR-
  4909.   ' GLOBAL fsel!                !TRUE=Fileselect-Box im AUTO-Ordner
  4910.   mint!=@sys_cookie_jar("MiNT",gl_foo%)
  4911.   ltmf!=@sys_cookie_jar("LTMF",gl_foo%)
  4912.   vscr!=@sys_cookie_jar("VSCR",vscr_adr%)
  4913.   fsel!=@sys_cookie_jar("FSEL",gl_foo%)
  4914. RETURN
  4915. FUNCTION sys_cookie_jar(cookie$,VAR value%)
  4916.   $F%
  4917.   LOCAL cookie_adr%
  4918.   cookie_adr%=LPEEK(&H5A0)                      !Pointer zum Cookie-Jar
  4919.   IF cookie_adr%=0                              !Kein cookie-jar gefunden:
  4920.     RETURN 0                                    !Raus...
  4921.   ENDIF
  4922.     ' PRINT MKL$({cookie_adr%})'                !Hier steht der Name
  4923.     IF {cookie_adr%}={V:cookie$}                !GOTCHA
  4924.       value%={ADD(cookie_adr%,4)}
  4925.       RETURN -1
  4926.     ENDIF
  4927.     '
  4928.     ADD cookie_adr%,8
  4929.   LOOP UNTIL {cookie_adr%}=0
  4930.   RETURN 0
  4931. ENDFUNC
  4932. PROCEDURE vscr_xywh(vscr_adr%,VAR vscr_x&,vscr_y&,vscr_w&,vscr_h&)
  4933.   ' EXTERN vscr_adr%       !Adr. des VSCR-
  4934.   ' EXTERN VAR vscr_x& ... !Koordinaten des aktuellen Bildschirmausschnitts
  4935.   LOCAL x&,y&,w&,h&        !Hilfskoordinaten
  4936.   CLR x&,y&,w&,h&          !Wei
  4937.  nicht mehr, warum hier CLR auf LOCALs, ohne
  4938.   '                        !lief's aber bei mir nicht richtig. :-)
  4939.   ' typedef struct         !C abschreiben leicht gemacht ... ;-)
  4940.   ' {
  4941.   ' ABSOLUTE vscr_cookie%,vscr_adr%
  4942.   ' ABSOLUTE vscr_product%,vscr_adr%+4
  4943.   ' ABSOLUTE vscr_version&,vscr_adr%+8
  4944.   ABSOLUTE x&,ADD(vscr_adr%,10)
  4945.   ABSOLUTE y&,ADD(vscr_adr%,12)
  4946.   ABSOLUTE w&,ADD(vscr_adr%,14)
  4947.   ABSOLUTE h&,ADD(vscr_adr%,16)
  4948.   ' } VSCR;
  4949.   ' PRINT "
  4950.   :"'HEX$(vscr_cookie%),MKL$(vscr_cookie%)
  4951.   ' PRINT "VSCR-Product:"'HEX$(vscr_product%),MKL$(vscr_product%)
  4952.   ' PRINT "VSCR-Version:"'HEX$(vscr_version&)
  4953.   vscr_x&=x&
  4954.   vscr_y&=y&
  4955.   vscr_w&=w&
  4956.   vscr_h&=h&
  4957. RETURN
  4958. lCookie ermitteln (nach Harder)                                GFA-Util
  4959. Autor: Peter Harder @ NF
  4960. Ich habe mir gerade mal eine Function zurechtgemacht, die die 
  4961. 'Adresse
  4962. eines Cookie ermittelt. Hier ist sie f
  4963. r alle, die sowas ebenfalls
  4964. gebrauchen k
  4965. nnen.
  4966. PRINT @cookie("
  4967. $NVDI")
  4968. PRINT @cookie("WINX")
  4969. PRINT @cookie("LTMF")  ! LETEMFLY
  4970. FUNCTION cookie(code$)
  4971.   $F%
  4972.   LOCAL code%,cookie_ptr%,i%
  4973.   cookie_ptr%=LPEEK(1440)  ! LPEEK() statt LONG{}, sonst Bomben
  4974.   IF cookie_ptr%>0 AND LEN(code$)=4
  4975.     '
  4976.     code%=CVL(code$)
  4977.     '
  4978.     FOR i%=cookie_ptr% TO cookie_ptr%+640 STEP 8
  4979.       ' PRINT MKL$({i%})  ! was ist 
  4980. berhaupt alles da?
  4981.       EXIT IF code%={i%} OR {i%}=0
  4982.     NEXT i%
  4983.     '
  4984.     IF code%={i%}
  4985.       RETURN i%  ! Adresspointer zur
  4986. ck, Info mit {i%+4} auslesen
  4987.     ELSE
  4988.       RETURN FALSE
  4989.     ENDIF
  4990.   ELSE
  4991.     RETURN FALSE
  4992.   ENDIF
  4993. ENDFUNC
  4994. lCookie ermitteln (nach ??)                                    GFA-Util
  4995. Autor: 
  4996.   @ XYZ
  4997. DEFFN find_cookie(cookie$)=C:
  4998.  (L:CVL(cookie$))
  4999. lVSCR-Cookie                                                   GFA-Util
  5000. Autor: 
  5001. 1Oliver Schildmann @ LU
  5002. eFrage:
  5003. nnte mal jemand so nett sein und posten, wie der VSCR-
  5004.     Cookie aufgebaut ist und wie man mit seiner Hilfe Dialogboxen im
  5005.     sichtbaren Bildschirmausschnitt zentriert?
  5006. Mein FORM_CENTER beachtet VSCR (wenn VSCR!=TRUE), kann aber die
  5007. Dialoge auch an die Mausposition setzen (wenn BOXPOS!=TRUE). Ist
  5008. MultiDialog installiert (legt Dialoge in Fenster, sehr zu empfehlen
  5009. unter MTOS), so wird die 
  5010. bliche Dialogumrandung entfernt, da ja
  5011. jetzt ein Fensterrahmen existiert. Wird die 
  5012. 'Adresse des Dialoge
  5013. negativ 
  5014. bergeben, so wird 
  5015. ltrotz
  5016. d MultiDialog die Dialogumrandung
  5017. lnicht
  5018. d enfernt (MultiDialog kann dann vor dem Zeichnen abgeschaltet
  5019. werden).
  5020. ' Globale Variablen:
  5021. ' X.rez&, Y.rez&, Menu.h&, Mdia!, Mdia%, Vscr! und Boxpos!
  5022. ' X.rez&=Succ(Work_out(0))              ! Maximale Aufl
  5023. sung in X-Richtung
  5024. ' Y.rez&=Succ(Work_out(1))              ! Maximale Aufl
  5025. sung in Y-Richtung
  5026. ' Menu.h& ist die H
  5027. he der Men
  5028. zeile (i.d.R. 19, ist identisch mit dem Y-
  5029. ' Wert des Arbeitsbereiches Work.y&).
  5030. ' ~@Mousex und ~@Mousey sind ein 
  5031.  -Ersatz f
  5032. r die GFA-Befehle
  5033. @Form_center(Dialog_adr%,X&,Y&,W&,H&) ! Mdia! & Mdia% werden aktualisiert
  5034. @Mdia(False)                          ! MultiDialog abschalten (wenn aktiv)
  5035. ' Hier kommt der Dialog hin
  5036. @Mdia(True)                           ! MultiDialog ggf. wieder anschalten
  5037. > procedure Form_center(Adr%,Var X&,Y&,W&,H&) ! Form_center (VSCR & MDIA werden beachtet)
  5038. ' -----------------------------
  5039. ' FORM_CENTER (VSCR/MDIA/MOUSE)
  5040. ' ----------------------------- 1.3 130494
  5041. ' Parameter : Adr% (
  5042. 'Adresse des zu zentrierenden Objektes, <0->kein MDIALOG)
  5043. ' PreProc   : -
  5044. ' InlineProc: -
  5045. ' InlineFunc: Mdia, Get.cookie
  5046. ' Konstante : Vscr! (True, wenn Boxen zentriert werden sollen)
  5047. '             Boxpos! (True, wenn Boxen an Mausposition)
  5048. '             X.rez&, Y.rez&, Menu.h&   (H
  5049. he der Men
  5050. zeile)
  5051. ' Variable  : -
  5052. ckgabe  : X&,Y&,W&,H& (Position und Gr
  5053. e des Dialoges)
  5054. Local Work.x&,Work.y&,Work.w&,Work.h&
  5055. ' Multi-Dialog!
  5056. If @Mdia And Adr%>0                           ! Wenn MULTIDIALOG installiert
  5057.   Ob_state(Adr%,0)=Bclr(Ob_state(Adr%,0),4)   ! (und erw
  5058. nscht) OUTLINED off
  5059.   Ob_spec(Adr%,0)=Bclr(Ob_spec(Adr%,0),17)    ! Rahmendicke=0
  5060. Else                                          ! Wenn nicht (oder deaktiviert)
  5061.   Adr%=Abs(Adr%)                              ! Adr% ggf. zur
  5062. cksetzen
  5063.   Ob_state(Adr%,0)=Bset(Ob_state(Adr%,0),4)   ! OUTLINED on
  5064.   Ob_spec(Adr%,0)=Bset(Ob_spec(Adr%,0),17)    ! Rahmendicke=2
  5065. Endif
  5066. If Boxpos!
  5067.   ' Maus in der Mitte der Dialogbox
  5068. 2' #UMBRUCH ANFANG!
  5069.   X&=Max(3,Min(Sub(@Mousex,Div(Ob_w(Adr%,0),2))
  5070.   ,Sub(Sub(X.rez&,Ob_w(Adr%,0)),3)))
  5071.   Y&=Max(Add(3+(Btst(Ob_state(Adr%,0),4)=False)*3,Menu.h&-
  5072.   ((Btst(Ob_state(Adr%,0),4))=False)*Menu.h&),Min
  5073.   (Sub(@Mousey,Div(Ob_h(Adr%,0),2)),Sub(Sub(Y.rez&,
  5074.   Ob_h(Adr%,0)),3)))
  5075. 0' #UMBRUCH ENDE!
  5076.   W&=Ob_w(Adr%,0)
  5077.   H&=Ob_h(Adr%,0)
  5078.   Ob_x(Adr%,0)=X&
  5079.   Ob_y(Adr%,0)=Y&
  5080. Else if Vscr!
  5081.   ~@Get.
  5082. 'cookie("VSCR",Vscr.
  5083.  )    ! Wenn Berechnung n
  5084.   ~Wind_get(0,7,Work.x&,Work.y&,Work.w&,Work.h&) ! Maximaler Arbeitsbereich
  5085.   Vscr.x&=Card{Add(Vscr.
  5086.  ,10)}  ! Bildschirmausschnitt: X-Wert
  5087.   Vscr.y&=Card{Add(Vscr.
  5088.  ,12)}  ! Bildschirmausschnitt: Y-Wert
  5089.   Vscr.w&=Card{Add(Vscr.
  5090.  ,14)}  ! Bildschirmausschnitt: Breite
  5091.   Vscr.h&=Card{Add(Vscr.
  5092.  ,16)}  ! Bildschirmausschnitt: H
  5093.   W&=Sub(Ob_w(Adr%,0),Mul(6,Btst(Ob_state(Adr%,0),4))) ! Dialogma
  5094. e inkl. der
  5095.   H&=Sub(Ob_h(Adr%,0),Mul(6,Btst(Ob_state(Adr%,0),4))) ! OUTLINE-Umrandung
  5096.   X&=Add(Vscr.x&,Div(Vscr.w&-W&+Work.x&,2)) ! Dialog im Bildschirm zentrieren
  5097.   Y&=Add(Vscr.y&,Div(Vscr.h&-H&+Work.y&,2)) ! und den Offset addieren
  5098.   Ob_x(Adr%,0)=X&
  5099.   Ob_y(Adr%,0)=Y&
  5100. Else                                   ! Ansonsten nur normaler 
  5101.  -Aufruf,
  5102.   If Ob_x(Adr%,0)=0 And Ob_y(Adr%,0)=0 ! wenn die Dialogbox nicht schon
  5103.     ~Form_center(Adr%,X&,Y&,W&,H&)     ! plaziert worden ist!
  5104.   Else
  5105.     X&=Ob_x(Adr%,0)
  5106.     Y&=Ob_y(Adr%,0)
  5107.     W&=Ob_w(Adr%,0)
  5108.     H&=Ob_h(Adr%,0)
  5109.   Endif
  5110. Endif
  5111. Return
  5112. > function Mousex                 ! 
  5113.  -Ersatz f
  5114. r GfA MOUSEX-Befehl
  5115.  Local Mx%,My%,Mk%,Ut%
  5116.  ~Graf_mkstate(Mx%,My%,Mk%,Ut%)
  5117.  Return Mx%
  5118. Endfunc
  5119. > function Mousey                 ! 
  5120.  -Ersatz f
  5121. r GfA MOUSEY-Befehl
  5122.  Local Mx%,My%,Mk%,Ut%
  5123.  ~Graf_mkstate(Mx%,My%,Mk%,Ut%)
  5124. Return My%
  5125. Endfunc
  5126. > function Mdia                   ! Ist MDIALOG installiert und aktiv?
  5127. ' ------------
  5128. ' MULTIDIALOG?
  5129. ' ------------ 1.0 240394
  5130. ' Parameter : -
  5131. ' PreProc   : -
  5132. ' InlineProc: -
  5133. ' InlineFunc: Get.cookie
  5134. ' Konstante : Mdia! (MULTIDIALOG an/aus (TRUE/FALSE)
  5135. '             Mdia% (
  5136. 'Adresse des MDIA-Parameterblocks)
  5137. ' Variable  : -
  5138. ' Ergebnis  : TRUE, wenn MDIA existiert und aktiv ist, sonst FALSE
  5139. Mdia!=@Get.
  5140. 'cookie("MDIA",Mdia%)
  5141. If Mdia!
  5142.  Mdia!=Btst({Mdia%},31)
  5143.  Clr Mdia%
  5144. Endif
  5145. Return Mdia!
  5146. Endfunc
  5147. > procedure Mdia(Flag&)           ! MDIALOG an- und abschalten
  5148. ' --------------------------
  5149. ' MULTIDIALOG AN-/ABSCHALTEN
  5150. ' -------------------------- 1.0 240394
  5151. ' Parameter : Flag& (Wert wechseln (Change/1), setzen (True), l
  5152. schen (False)
  5153. ' PreProc   : -
  5154. ' InlineProc: -
  5155. ' InlineFunc: -
  5156. ' Konstante : Mdia! (True, wenn MDIALOG installiert _und_ aktiv)
  5157. '             Mdia% (MDIA-Cookie, ist <>0, wenn MDIALOG installiert ist)
  5158. ' Variable  : -
  5159. If Mdia!              ! Ist MDIALOG installiert und ist oder war es aktiv
  5160.  If Flag&=True               ! MDIALOG einschalten
  5161.   {Mdia%}=Bset({Mdia%},31)
  5162.  Else if Flag&=False         ! MDIALOG ausschalten
  5163.   {Mdia%}=Bclr({Mdia%},31)
  5164.  Else                        ! MDIALOG-Status wechseln
  5165.   {Mdia%}=Bchg({Mdia%},31)
  5166.  Endif
  5167. Endif
  5168. Return
  5169. lStringmanipulationen                                          GFA-Util
  5170.  7.1 
  5171.  7.2 
  5172.  7.3 
  5173.  7.4 
  5174.  7.5 
  5175.  7.6 
  5176.  7.7 
  5177.  7.8 
  5178.  7.9 
  5179.  7.10 
  5180.  7.11 
  5181.  7.12 
  5182. lString teilen                                                 GFA-Util
  5183. Autor: 
  5184. 0Gregor Duchalski @ DO
  5185. ' Gibt den ersten Teil eines durch '|' abgeteilten Strings zur
  5186. ck und
  5187. ' verk
  5188. rzt den Originalstring...
  5189. ' Beispiel: a$="ABC|DEF" ==> @teil$(a$)="ABC"; a$="DEF"
  5190. > FUNCTION teil$(VAR a$)
  5191.   LOCAL b$,a&
  5192.   a&=INSTR(a$,"|")
  5193.   IF a&
  5194.    b$=LEFT$(a$,PRED(a&))
  5195.    a$=MID$(a$,SUCC(a&))
  5196.   ELSE
  5197.    b$=a$
  5198.    a$=""
  5199.   ENDIF
  5200.   RETURN b$
  5201. ENDFUNC
  5202. lString einf
  5203. gen                                               GFA-Util
  5204. Autor: 
  5205. 0Gregor Duchalski @ DO
  5206. gt in den String b$ den String a$ an der Position a& ein...
  5207. > PROCEDURE insert(a$,a&,VAR b$)
  5208.   LOCAL c$
  5209.   c$=LEFT$(b$,PRED(a&))
  5210.   c$=c$+a$+MID$(b$,a&)
  5211.   b$=c$
  5212. RETURN
  5213. schen eines Teilstrings                                     GFA-Util
  5214. Autor: 
  5215. 0Gregor Duchalski @ DO
  5216. scht in a$ ab Position a& 'b&'-Zeichen...
  5217. > PROCEDURE delete(a&,b&,VAR a$)
  5218.   LOCAL c$
  5219.   c$=LEFT$(a$,PRED(a&))
  5220.   c$=c$+MID$(a$,a&+b&)
  5221.   a$=c$
  5222. RETURN
  5223. lErsetzen in einem String (als Prozedur)                       GFA-Util
  5224. Autor: 
  5225. 0Gregor Duchalski @ DO
  5226. ' Ersetzen in einem String...
  5227. ' Ersetzt in a$ ab Position a& 'b&'-positionen durch b$...
  5228. > PROCEDURE replace(a&,b&,b$,VAR a$)
  5229.   c$=LEFT$(a$,PRED(a&))
  5230.   c$=c$+b$+MID$(a$,a&+b&)
  5231.   a$=c$
  5232. RETURN
  5233. lErsetzen in einem String (als Funktion)                       GFA-Util
  5234. Autor: Peter Harder @ NF
  5235. FUNCTION replace$(strng$,raus$,rein$)
  5236.   ' Aufrufbeispiel:
  5237.   ' PRINT @replace$("Muetze","ue","
  5238. ") ! schreibt "M
  5239.   LOCAL right$,len_dif&,pos&,beg&
  5240.   len_dif&=LEN(rein$)-LEN(raus$)
  5241.   pos&=INSTR(strng$,raus$)
  5242.   WHILE pos&
  5243.     '
  5244.     right$=MID$(strng$,pos&+LEN(raus$))
  5245.     IF LEN(strng$)+len_dif&<=32767
  5246.       strng$=LEFT$(strng$,pos&-1)+rein$+right$
  5247.     ENDIF
  5248.     '
  5249.     beg&=pos&+1+len_dif&
  5250.     pos&=INSTR(beg&,strng$,raus$)
  5251.   WEND
  5252.   RETURN strng$
  5253. ENDFUNC
  5254. lAbschneiden von Leerzeichen                                   GFA-Util
  5255. Autor: 
  5256. 0Gregor Duchalski @ DO
  5257. ' Abschneiden der Leerzeichen am linken bzw. rechten Rand eines
  5258. ' Strings...
  5259. > FUNCTION ltrim$(a$)
  5260.   FOR i&=1 TO LEN(a$)
  5261.    IF MID$(a$,i&,1)=" "
  5262.     INC pos&
  5263.    ELSE
  5264.     i&=LEN(a$)
  5265.    ENDIF
  5266.   NEXT i&
  5267.   a$=RIGHT$(a$,SUB(LEN(a$),pos&))
  5268.   RETURN a$
  5269. ENDFUNC
  5270. > FUNCTION rtrim$(a$)
  5271.   pos&=LEN(a$)
  5272.   FOR i&=LEN(a$) DOWNTO 1
  5273.    IF MID$(a$,i&,1)=" "
  5274.     DEC pos&
  5275.    ELSE
  5276.     i&=1
  5277.    ENDIF
  5278.   NEXT i&
  5279.   a$=LEFT$(a$,pos&)
  5280.   RETURN a$
  5281. ENDFUNC
  5282. lBlocksatz                                                     GFA-Util
  5283. Autor: 
  5284. 0Gregor Duchalski @ DO
  5285. ' Blocksatz...
  5286. > FUNCTION blocksatz$(a$,a&)
  5287.   LOCAL b&,c&
  5288.   b&=1
  5289.   c&=a&-LEN(a$)
  5290.   WHILE c&>0
  5291.    b&=INSTR(a$," ",b&)
  5292.    IF b&=0
  5293.     b&=1
  5294.     b&=INSTR(a$," ",b&)
  5295.    ENDIF
  5296.    a$=LEFT$(a$,b&)+" "+RIGHT$(a$,LEN(a$)-b&)
  5297.    ADD b&,2
  5298.    DEC c&
  5299.   WEND
  5300.   RETURN a$
  5301. ENDFUNC
  5302. lEinf
  5303. gen von Dezimalpunkten                                   GFA-Util
  5304. Autor: 
  5305. 0Gregor Duchalski @ DO
  5306. gt in eine Zahl die Dezimalpunkte ein (z.B. 1234="1.234")...
  5307. > FUNCTION dez.pkt$(a%)
  5308.   LOCAL a$,b$,i&
  5309.   a$=STR$(a%)
  5310.   b$=""
  5311.   FOR i&=LEN(a$)-3 TO 1 STEP -3
  5312.    b$="."+MID$(a$,SUCC(i&),3)+b$
  5313.   NEXT i&
  5314.   b$=LEFT$(a$,(i&+3))+b$
  5315.   RETURN b$
  5316. ENDFUNC
  5317. lEinf
  5318. gen von Nullen                                           GFA-Util
  5319. Autor: 
  5320. 0Gregor Duchalski @ DO
  5321. gt in eine Zahl a& Nullen ein, bis L
  5322. nge b& erreicht...
  5323. DEFFN null$(a&,b&)=RIGHT$(STRING$(b&,"0")+STR$(a&),b&)
  5324. lLOWER$ = Gegenst
  5325. ck zu UPPER$                                 GFA-Util
  5326. Autor: 
  5327. /Michael Wedding @ AC3
  5328. ' ---------------------------------
  5329. ' LOWER$ = Gegenst
  5330. ck zu UPPER$!
  5331. ' Wandelt Gro
  5332. - in Kleinbuchstaben.
  5333. /Michael Wedding, Jul 21 1992
  5334. > FUNCTION lower$(b$)
  5335.   LOCAL i|,adr%,asc|,offset
  5336.   %adr%=V:b$
  5337.   FOR i|=0 TO PRED(LEN(b$))
  5338.    offset%=adr%+i|
  5339.    asc|=BYTE{offset%}
  5340.    SELECT asc|
  5341.    CASE 65 TO 90
  5342.     BYTE{offset%}=asc|+32
  5343.    CASE 128
  5344.     BYTE{offset%}=asc|+7
  5345.    CASE 142
  5346.     BYTE{offset%}=asc|-10
  5347.    CASE 143
  5348.     BYTE{offset%}=asc|-9
  5349.    CASE 144
  5350.     BYTE{offset%}=asc|-14
  5351.    CASE 146,165,181,193
  5352.     BYTE{offset%}=asc|-1
  5353.    CASE 153
  5354.     BYTE{offset%}=asc|-5
  5355.    CASE 154
  5356.     BYTE{offset%}=asc|-25
  5357.    CASE 178
  5358.     BYTE{offset%}=asc|+1
  5359.    CASE 182
  5360.     BYTE{offset%}=asc|-49
  5361.    CASE 183,184
  5362.     BYTE{offset%}=asc|-7
  5363.    ENDSELECT
  5364.   NEXT i|
  5365.  RETURN b$
  5366. ENDFUNC
  5367. ' ---------------------------------
  5368. lcut_left_str()                                                GFA-Util
  5369. Autor: Frank R
  5370. ger @ OS2
  5371. Die FUNCTION cut_left_str(VAR in$,out$) arbeitet 
  5372. hnlich, wie die C-
  5373. Funktion strtok() mit dem Trennzeichen " " (Space) und liefert als
  5374. Return die L
  5375. nge von out$. In out$ steht anschlie
  5376. end der erste
  5377. String aus in$ von links bis zum ersten Space (oder in$, falls kein
  5378. Space enthalten ist) und in in$ der Rest von in$ nach dem Abschneiden
  5379. von out$.
  5380. FUNCTION cut_left_str(VAR in$,out$)
  5381.   $F%
  5382.   LOCAL space&
  5383.   in$=TRIM$(in$)
  5384.   space&=INSTR(in$," ")
  5385.   IF space&
  5386.     out$=LEFT$(in$,PRED(space&))
  5387.     in$=TRIM$(MID$(in$,SUCC(space&)))
  5388.   ELSE
  5389.     out$=in$
  5390.     CLR in$
  5391.   ENDIF
  5392.   RETURN LEN(out$)
  5393. ENDFUNC
  5394. lAuff
  5395. llen mit Nullen                                          GFA-Util
  5396. Autor: 
  5397. 0Gregor Duchalski @ DO
  5398. ' Auff
  5399. llen mit Nullen...
  5400. > FUNCTION format$(a,a&)
  5401.   LOCAL a$,b&
  5402.   a$=STR$(a)+STRING$(SUCC(a&),"0")
  5403.   b&=INSTR(a$,".")
  5404.   RETURN LEFT$(a$,b&)+LEFT$(RIGHT$(a$,SUB(LEN(a$),b&))+"00",a&)
  5405. ENDFUNC
  5406. lSuchen                                                        GFA-Util
  5407.  8.1 
  5408.  8.2 
  5409.  8.3 
  5410.  8.4 
  5411.  8.5 
  5412. l'Boyer Moore' Suchalgorythmus                                 GFA-Util
  5413. Autor: 
  5414.   @ XYZ
  5415. ' Beispiel f
  5416. r Boyer Moore...
  5417. $m20000
  5418. RESERVE 200000
  5419. inlines
  5420. OPEN "i",#1,"e:\dfue\database\itb.txt"  ! ITB.TXT der Maus...
  5421. flen%=LOF(#1)
  5422. PRINT "L
  5423. nge: ";flen%;" Bytes"
  5424. adr%=MALLOC(flen%)
  5425. IF adr%>0
  5426.   t%=TIMER
  5427.   BGET #1,adr%,flen%
  5428.   PRINT "Zeit f
  5429. r Laden: ";(TIMER-t%)/200
  5430.   CLOSE #1
  5431.   s$="*AC3"
  5432.   t%=TIMER
  5433.   ptr%=@find_boyer(adr%,flen%,s$)
  5434.   PRINT "Zeit f
  5435. r Suche: ";(TIMER-t%)/200
  5436.   IF ptr%
  5437.     PRINT "Gefunden an 
  5438. 'Adresse: ";ptr%
  5439.     PRINT "Offset: ";ptr%-adr%
  5440.   ELSE
  5441.     PRINT "Nix gefundet!"
  5442.   ENDIF
  5443.   ~MFREE(adr%)
  5444.   ~INP(2)
  5445.   EDIT
  5446.   ALERT 1,"Kein Speicher!",1,"OK",ret%
  5447.   CLOSE #1
  5448. ENDIF
  5449. > FUNCTION find_boyer(buffer%,len%,ss$)
  5450.   LOCAL ss.len&
  5451.   ss.len&=LEN(ss$)
  5452.   PRINT "Buffer: ";buffer%
  5453.   PRINT "Len:    ";len%
  5454.   PRINT "Adr S$: ";V:ss$
  5455.   PRINT "S$-Len: ";STR$(ss.len&)
  5456.   PRINT "sbuf%:  ";sbuf%
  5457.   RETURN C:
  5458.  (L:buffer%,L:len%,L:V:ss$,ss.len&,L:sbuf%,L:
  5459. ENDFUNC
  5460. > PROCEDURE inlines
  5461.   ' Eigentliche Suchroutine
  5462.   INLINE 
  5463.  ,316
  5464.   ' Inline mit dem Zeichensatz... Musst Du mal mit rumprobieren...
  5465.   ' Wenn alle Zeichen auf Grossbuchstaben stehen, dann wird - glaube
  5466.   ' ich - nicht danach unterschieden. Ist im Inline Gross- sowie klein-
  5467.   ' schrift vorhanden, so wird beim 
  5468.   auch nach gross oder klein
  5469.   ' unterschieden
  5470.   INLINE 
  5471.  ,256
  5472.   ' sbuf% wird von Booyer Moore ben
  5473. tigt und sollte vor der Suche
  5474.   ' gel
  5475. scht werden.
  5476.   INLINE sbuf%,1000
  5477.   a$=SPACE$(1000)
  5478.   BMOVE V:a$,sbuf%,1000
  5479. RETURN
  5480. lDateinamen suchen                                             GFA-Util
  5481. Autor: 
  5482.   @ XYZ
  5483. GOSUB dir("F:\CALAMUS\FONTS\","*.CFN") ! Aufruf der Routine um den
  5484.                                        ! Ordner zu durchsuchen...
  5485. QSORT datei$(),datei_count&            ! Alle Daten sortieren...
  5486. ' Sortierte dateien anzeigen...
  5487.   PRINT datei$(i&)
  5488.   INC i&
  5489. LOOP UNTIL i&>datei_count&
  5490. ~INP(2)       ! Auf taste warten
  5491. PROCEDURE dir(path$,msk$)
  5492.   LOCAL datei$,fertig&
  5493.   ERASE datei$()
  5494.   DIM datei$(1000)
  5495.   ~FSETDTA(BASEPAGE+128)
  5496.   datei_count&=0
  5497.   fertig&=FSFIRST(path$+msk$+CHR$(0),7)  ! Erste Datei suchen..
  5498.   DO UNTIL fertig&                       ! wenn 1. o. n
  5499. chste gefunden
  5500.     datei$=CHAR{FGETDTA()+30}            ! Dateiname ermitteln
  5501.     INC datei_count&                     ! Zaehler
  5502.     datei$(datei_count&)=path$+datei$    ! ARRAY belegen
  5503.     fertig&=FSNEXT()                     ! N
  5504. chste suchen...
  5505.   LOOP
  5506. RETURN
  5507. lSuchen in einem eindimensionalen Stringfeld                   GFA-Util
  5508. Autor: 
  5509. 0Gregor Duchalski @ DO
  5510. ' Suchen in einem eindimensionalen Stringfeld : von,bis,feld,such$...
  5511. > FUNCTION instr(a&,b&,VAR a$(),b$)
  5512.   IF b&>PRED(DIM?(a$()))
  5513.    ALERT 3," | Funktion INSTR nicht | durchf
  5514. hrbar! ",1,"Abbruch",b&
  5515.   ELSE
  5516.    IF a&=-1
  5517.     a&=1
  5518.     b&=PRED(DIM?(a$()))
  5519.    ENDIF
  5520.   FOR i&=a& TO b&
  5521.    IF a$(i&)=b$
  5522.     RETURN i&
  5523.    ENDIF
  5524.   NEXT i&
  5525.   ENDIF
  5526.   RETURN -1
  5527. ENDFUNC
  5528. lSuchen in einem Speicherbereich                               GFA-Util
  5529. Autor: 
  5530. 0Gregor Duchalski @ DO
  5531. ' Sucht den String 'find$' an der 
  5532. 'Adresse 'adr%' im Speicherbereich
  5533. ' mit der L
  5534. nge 'l%'...
  5535. > FUNCTION find_string(find$,adr%,l%)       ! Search a string
  5536.   $F%
  5537.   LOCAL len&,a&,a%,a$
  5538.   ' last change 14.04.93
  5539.   len&=MIN(l%,4100)                       ! L
  5540. nge des Teilstrings
  5541.   a$=STRING$(len&,0)                      ! Teilstring
  5542.   a%=adr%                                 ! Startadresse
  5543.   end%=ADD(adr%,PRED(l%))                 ! Endadresse
  5544.   DO WHILE ADD(a%,len&)<end%
  5545.    BMOVE a%,V:a$,len&
  5546.    ADD a%,len&
  5547.    a&=INSTR(a$,find$)
  5548.   LOOP UNTIL a&
  5549.   rest&=SUB(end%,PRED(a%))
  5550.   IF a&=0 AND rest&>0
  5551.    BMOVE a%,V:a$,rest&
  5552.    ADD a%,len&
  5553.    a&=INSTR(a$,find$)
  5554.   ENDIF
  5555.   IF a&
  5556.    RETURN a%-len&+PRED(a&)
  5557.   ENDIF
  5558.   RETURN 0
  5559. ENDFUNC
  5560. lSuchen (Berger'sche Variante)                                 GFA-Util
  5561. Autor: Axel Berger @ RS
  5562. neustart:
  5563. select
  5564. ' ------------------------
  5565. > PROCEDURE init
  5566.   DEFSTR "a-b"
  5567.   DEFBYT "i-j"
  5568.   DEFWRD "k-n"
  5569.   DEFINT "l"
  5570.   OPTION BASE 0
  5571.   ' -----------
  5572.   version$="1.50"
  5573.   versdat$="93-10-20"
  5574.   apath=":\*.*"
  5575.   astri=""
  5576.   alist="C:\CLIPBRD\FILE_FAB.LST"
  5577.   ' -----------
  5578.   ON ERROR GOSUB fehler
  5579.   CLOSE
  5580.   CLS
  5581. RETURN
  5582. > PROCEDURE fehler
  5583.   LOCAL ausgang,i
  5584.   IF FATAL
  5585.     ~FORM_ALERT(1,ERR$(ERR))
  5586.     CLOSE
  5587.     END
  5588.   ELSE
  5589.     ausgang=ERR$(ERR)
  5590.     ausgang=LEFT$(ausgang,RINSTR(ausgang,"]",LEN(ausgang)-2)-1)
  5591.     i=
  5592. #MAX(0,22+MAX(RINSTR(ausgang,"|"),RINSTR(ausgang,"["))-LEN(ausgang))
  5593.     ausgang=ausgang+STRING$(i," ")+"][Abbruch|Weiter|Neustart]"
  5594.     i=FORM_ALERT(1,ausgang)
  5595.     IF i=2
  5596.       ON ERROR GOSUB fehler
  5597.       RESUME NEXT
  5598.     ELSE IF i=3
  5599.       ON ERROR GOSUB fehler
  5600.       RESUME neustart
  5601.     ELSE
  5602.       CLOSE
  5603.       END
  5604.     ENDIF
  5605.   ENDIF
  5606. RETURN
  5607. ' ------------------------
  5608. > PROCEDURE select
  5609.   LOCAL i,nolist,a,m,k
  5610.   CLOSE
  5611.   CLS
  5612.     lfile=0
  5613.     PRINT "SUCH_FAB, Version: ";version$
  5614.     PRINT "              vom: ";versdat$
  5615.     PRINT "Suchpfad:   ";
  5616.     a=apath
  5617.     FORM INPUT 255 AS a
  5618.     IF a=""
  5619.       m=1
  5620.       m=FSEL_INPUT(apath,a,k)
  5621.       EXIT IF m*k=0
  5622.       IF LEN(a)
  5623.         apath=LEFT$(apath,RINSTR(apath,"\"))+a
  5624.       ELSE
  5625.         apath=LEFT$(apath,RINSTR(apath,"\"))+"*.*"
  5626.       ENDIF
  5627.       PRINT " ASuchpfad:   ";apath
  5628.     ELSE
  5629.       apath=UPPER$(a)
  5630.       EXIT IF NOT INSTR(apath,":\")=2
  5631.       EXIT IF NOT RINSTR(apath,".")>RINSTR(apath,"\")
  5632.     ENDIF
  5633.     ' -------
  5634.     PRINT "Suchstring: ";
  5635.     FORM INPUT 255 AS astri
  5636.     PRINT "Ausgabe in: ";
  5637.     FORM INPUT 255 AS alist
  5638.     IF alist=""
  5639.       nolist=1
  5640.     ELSE
  5641.       OPEN "o",#2,alist
  5642.       nolist=0
  5643.     ENDIF
  5644.     find(apath,astri,nolist)
  5645.     PRINT CHR$(7)
  5646.     CLOSE
  5647.     IF CRSLIN>15 AND LEN(astri)=0
  5648.       WHILE INKEY$="" AND MOUSEK=0
  5649.       WEND
  5650.       CLS
  5651.     ENDIF
  5652.     PRINT "Es wurden ";lfile;" Files nach """+astri+""" durchsucht."
  5653.     PRINT
  5654.     PRINT
  5655.     PRINT
  5656.   LOOP
  5657. RETURN
  5658. > PROCEDURE find(ap,as,n)
  5659.   LOCAL adta,aext,afile,k,i
  5660.   IF UPPER$(LEFT$(ap))="X"
  5661.     FOR i=ASC("C") TO ASC("P")
  5662.       MID$(ap,1)=CHR$(i)
  5663.       find(ap,as,n)
  5664.     NEXT i
  5665.   ELSE IF INKEY$=" "
  5666.     ERROR 7
  5667.   ELSE
  5668.     adta=STRING$(50," ")
  5669.     ~FSETDTA(VARPTR(adta))
  5670.     ' -----------
  5671.     aext=MID$(ap,RINSTR(ap,"\"))
  5672.     k=FSFIRST(ap,&X100111)
  5673.     ap=LEFT$(ap,RINSTR(ap,"\"))
  5674.     DO UNTIL k
  5675.       afile=ap+CHAR{VARPTR(adta)+30}
  5676.       seek(afile,as,n)
  5677.       ~FSETDTA(VARPTR(adta))
  5678.       k=FSNEXT()
  5679.     LOOP
  5680.     ' -----------
  5681.     k=FSFIRST(ap+"*.*",16)
  5682.     DO UNTIL k
  5683.       afile=CHAR{VARPTR(adta)+30}
  5684.       IF PEEK(VARPTR(adta)+21)=16 AND NOT (afile="." OR afile="..")
  5685.         afile=ap+afile+aext
  5686.         find(afile,as,n)
  5687.         ~FSETDTA(VARPTR(adta))
  5688.       ENDIF
  5689.       k=FSNEXT()
  5690.     LOOP
  5691.     ' -----------
  5692.   ENDIF
  5693. RETURN
  5694. > PROCEDURE seek(af,as,n)
  5695.   LOCAL adta,lang,l,neu,block,mpos,manf,mend
  5696.   adta=STRING$(50," ")
  5697.   ~FSETDTA(VARPTR(adta))
  5698.   IF EXIST(af)
  5699.     lfile=lfile+1
  5700.     PRINT lfile;": "+af
  5701.     IF LEN(as)
  5702.       OPEN "I",#1,af
  5703.       lang=LOF(#1)
  5704.       FOR l=1 TO lang-1 STEP 31000
  5705.         SEEK #1,l-1
  5706.         neu=MIN(32000,lang-l+1)
  5707.         block=INPUT$(neu,#1)
  5708.         mpos=INSTR(block,as)
  5709.         WHILE mpos
  5710.           manf=
  5711. #MAX(1,mpos-34)
  5712.           mend=MIN(mpos+44,lang)
  5713.           PRINT "  p"+MID$(block,manf,mend-manf+1)+" q"
  5714.           PRINT lfile;": "+af+CHR$(7)
  5715.           IF n=1
  5716.             WHILE INKEY$="" AND MOUSEK=0
  5717.             WEND
  5718.           ELSE
  5719.             PRINT #2,lfile;": "+af
  5720.             PRINT #2,MID$(block,manf,mend-manf+1)
  5721.             PRINT #2,lfile;": "+af
  5722.           ENDIF
  5723.           mpos=INSTR(block,as,mpos+1)
  5724.         WEND
  5725.       NEXT l
  5726.       CLOSE #1
  5727.     ELSE
  5728.       IF n=0
  5729.         datum(adta,block)
  5730.         PRINT #2,block;af
  5731.         ' PRINT #2,lfile;": "+af
  5732.       ELSE IF CRSLIN>23
  5733.         PRINT CHR$(7);
  5734.         WHILE INKEY$="" AND MOUSEK=0
  5735.         WEND
  5736.         CLS
  5737.       ENDIF
  5738.     ENDIF
  5739.   ELSE
  5740.     ERROR 23
  5741.   ENDIF
  5742. RETURN
  5743. > PROCEDURE datum(VAR adta,block)
  5744.   LOCAL lfile,mdat,mtim
  5745.   block=" "
  5746. RETURN
  5747. lSortieren                                                     GFA-Util
  5748.  9.1 
  5749.  9.2 
  5750. lDateinamen sortieren                                          GFA-Util
  5751. Autor: 
  5752.   @ KR
  5753. REM Array erstellen
  5754. DIM string$(99)                         ! Nur f
  5755. r Testzwecke
  5756. fuellzeichen$=CHR$(0)                   ! Kleinster ASCII-Wert
  5757. max_dat_len|=8                          ! So lang ist ein 'kurzer' Dateiname
  5758. REM ... und belegen
  5759. FOR i|=1 TO 99
  5760.   string$(i|)="File_"+STR$(i|)
  5761. NEXT i|
  5762. REM Auff
  5763. llen mit den F
  5764. llzeichen
  5765. FOR i|=0 TO 99                          ! Alle Strings durchgehen
  5766.   REM Zahlen suchen...
  5767.   FOR z&=0 TO LEN(string$(i|))
  5768.     IF VAL?(MID$(string$(i|),z&,1))<>0
  5769.       p&=z&
  5770.       anz&=VAL(MID$(string$(i|),PRED(z&)))
  5771.     ENDIF
  5772.   NEXT z&
  5773.   IF p&<>0                         ! Wenn eine Zahl gefunden wurde...
  5774.     '
  5775.     REM Linker Teil des Strings geht bis Anfang Zahl
  5776.     '
  5777.     leftstring$=LEFT$(string$(i|),PRED(p&))
  5778.     '
  5779.     REM F
  5780. llstring zum Auff
  5781. llen mit CHR$(0) auf max_dat_len|
  5782.     '
  5783.     fuellstring$=STRING$(max_dat_len|-LEN(string$(i|)),fuellzeichen$)
  5784.     '
  5785.     REM Rechter Teil d. Strings geht ab Ende d. Zahl bis Ende String
  5786.     '
  5787.     rightstring$=RIGHT$(string$(i|),SUCC(LEN(string$(i|))-p&))
  5788.     '
  5789.     REM Alles zusammenpappen...
  5790.     '
  5791.     string$(i|)=leftstring$+fuellstring$+rightstring$
  5792.     '
  5793.   ENDIF
  5794. NEXT i|
  5795. QSORT string$()
  5796. REM ... und wieder auseianderdr
  5797. FOR i|=0 TO 99
  5798.   string$=string$(i|)
  5799.     p|=INSTR(string$,fuellzeichen$)
  5800.     EXIT IF p|=0
  5801.     delete(p|,1,string$)
  5802.   LOOP
  5803.   string$(i|)=string$
  5804. NEXT i|
  5805. REM und feddich...
  5806. lSortieren (nach Skuplik)                                      GFA-Util
  5807. Autor: Roland Skuplik @ DO2
  5808. Nachfolgend eine Routine, die eine Stringfeld von l| bis r| sortiert,
  5809. und zwar nach dem QUICK-SORT-Algorithmus!
  5810. r andere Anwendungen etwas umschreiben, aber das Prinzip sollte
  5811. daraus klar werden.
  5812. 'PROCEDURE quick(l|,r|)
  5813.   LOCAL i|,j|,x|
  5814.   i|=l|
  5815.   j|=r|
  5816.   x$=feld$((l|+r|) DIV 2)
  5817.   REPEAT
  5818.     WHILE feld$(i|)<x$
  5819.       INC i|
  5820.     WEND
  5821.     WHILE x$<feld$(j|)
  5822.       DEC j|
  5823.     WEND
  5824.     IF i|<=j|
  5825.       SWAP feld$(i|),feld$(j|)
  5826.       INC i|
  5827.       DEC j|
  5828.     ENDIF
  5829.   UNTIL i|>j|
  5830.   IF l|<j|
  5831.     quick(l|,j|)
  5832.   ENDIF
  5833.   IF i|<r|
  5834.     quick(i|,r|)
  5835.   ENDIF
  5836. RETURN
  5837. lRoutinen rund um's Datum                                      GFA-Util
  5838. 10.1 
  5839. 10.2 
  5840. 10.3 
  5841. 10.4 
  5842. 10.5 
  5843. 10.6 
  5844. 10.7 
  5845. 10.8 
  5846. 10.9 
  5847. lDatumsroutinen                                                GFA-Util
  5848. Autor: 
  5849.   @ XYZ
  5850. ' Datumsroutinen in GFA-Basic
  5851. ' Beipiel:
  5852. PRINT "Es ist "+@
  5853. ,welcher_tag$(23,1,1994)+"!"
  5854. PRINT "Es ist der "+STR$(@
  5855. &tag_nr(23,1,94))+". tag im Jahr"
  5856. PRINT tnr% ! Da steht dann das Ergebnis drin ..
  5857. t1%=23
  5858. m1%=1
  5859. j1%=94
  5860. anz%=37                  ! normal = ADD / mit "-" davor = SUB
  5861. GOSUB 
  5862. +dat_rechnen(t1%,m1%,j1%,anz%,t%,m%,j%)
  5863. PRINT t1%;".";m1%;".";j1%;" ";anz%;" Tage = ";t%;".";m%;".";j%
  5864. lDer wievielte Tag im Jahr ist heute?                          GFA-Util
  5865. Autor: 
  5866.   @ XYZ
  5867. > FUNCTION tag_nr(t%,m%,j%)
  5868.   ' Der wievielte tag im Jahr ist heute?
  5869.   IF m%>2
  5870.     tnr%=INT((m%+1)*30.6)-63+t%
  5871.     IF j% MOD 4=0
  5872.       INC tnr%                        ! Schaltjahr
  5873.     ENDIF
  5874.   ELSE
  5875.     tnr%=INT((m%+13)*30.6)-428+t%
  5876.   ENDIF
  5877.   RETURN tnr%
  5878. ENDFUNC
  5879. lDer wievielte Tag ist heute?                                  GFA-Util
  5880. Autor: 
  5881.   @ XYZ
  5882. > FUNCTION tag_zahl(t%,m%,j%)
  5883.   ' Berechnet den genauen Tag. Gerechnet ab dem 1.3.0000
  5884.   IF m%>2
  5885.     SUB m%,3
  5886.   ELSE
  5887.     ADD m%,9
  5888.     DEC j%
  5889.   ENDIF
  5890.   jh%=j%/100
  5891.   jt%=j%-100*jh%
  5892.   RETURN INT(146097*jh%/4)+INT(1461*jt%/4)+INT((153*m%+2)/5)+t%
  5893. ENDFUNC
  5894. lAbsolutes Datum -> Kalenderdatum                              GFA-Util
  5895. Autor: 
  5896.   @ XYZ
  5897. > PROCEDURE recalc(tnr%,VAR t%,m%,j%)
  5898.   ' Rechnet absolutes Datum wieder zur
  5899. ck in Kalenderdatum
  5900.   j%=(4*tnr%-1)/146097
  5901.   tnr%=4*tnr%-146097*j%-1
  5902.   t%=tnr%/4
  5903.   tnr%=(t%*4+3)/1461
  5904.   t%=4*t%+3-1461*tnr%
  5905.   t%=(t%+4)/4
  5906.   m%=(5*t%-3)/153
  5907.   t%=((5*t%-3-153*m%)+5)/5
  5908.   j%=100*j%+tnr%
  5909.   IF m%<10
  5910.     ADD m%,3
  5911.   ELSE
  5912.     SUB m%,9
  5913.     INC j%
  5914.   ENDIF
  5915. RETURN
  5916. lWelcher Wochentag ist heute?                                  GFA-Util
  5917. Autor: 
  5918.   @ XYZ
  5919. tigt wird: '
  5920. (tag_zahl'
  5921. > FUNCTION welcher_tag$(t%,m%,j%)
  5922.   ' Welcher Wochentag ist heute?
  5923.   RESTORE wochentage
  5924.   IF in!=FALSE
  5925.     DIM n$(6)
  5926.     wochentage:
  5927.     DATA Sonntag,Montag,Dienstag,Mittwoch,Donnerstag,Freitag,Samstag
  5928.     FOR i%=0 TO 6
  5929.       READ n$(i%)
  5930.     NEXT i%
  5931.     in!=TRUE
  5932.   ENDIF
  5933.   tz%=@
  5934. (tag_zahl(t%,m%,j%)
  5935.   wt%=(tz%-719750+5)-INT((tz%-719750+5)/7)*7 ! In Relation zu 9.10.1970
  5936.   RETURN n$(wt%)
  5937. ENDFUNC
  5938. lDifferenz zwischen zwei Daten                                 GFA-Util
  5939. Autor: 
  5940.   @ XYZ
  5941. tigt wird: '
  5942. (tag_zahl'
  5943. > FUNCTION dat_dif(t1%,m1%,j1%,t2%,m2%,j2%)
  5944.   ' Differenz zwischen zwei Daten
  5945.   RETURN ABS(@
  5946. (tag_zahl(t1%,m2%,j1%)-@tag_zahl(t2%,m2%,j2%))
  5947. ENDFUNC
  5948. lRechnet mit Daten                                             GFA-Util
  5949. Autor: 
  5950.   @ XYZ
  5951. tigt wird: '
  5952. (tag_zahl' und '
  5953. &recalc'
  5954. > PROCEDURE dat_rechnen(t1%,m1%,j1%,a%,VAR t2%,m2%,j2%)
  5955.   LOCAL tnr%
  5956.   ' 'dat_rechnen' addiert einen Wert zu einem Datum.
  5957.   '  Bzw. wenn a% negativ ist, wird subtrahiert.
  5958.   tnr%=@
  5959. (tag_zahl(t1%,m1%,j1%)
  5960.   ADD tnr%,a%
  5961.   GOSUB 
  5962. &recalc(tnr%,t2%,m2%,j2%)
  5963. RETURN
  5964. lUnix-Datum in echtes Datum wandeln                            GFA-Util
  5965. Autor: 
  5966.   @ XYZ
  5967. init_time_constants_and_variables   ! Einmal am Anfang aufrufen
  5968. DIM lt&(8)
  5969. IF @localtime(782497122,lt&())
  5970.   PRINT RIGHT$("0"+STR$(lt&(tm_mday&)),2);".";
  5971.   PRINT RIGHT$("0"+STR$(SUCC(lt&(tm_mon&))),2);".";
  5972.   PRINT STR$(1900+lt&(tm_year&))'
  5973.   PRINT RIGHT$("0"+STR$(lt&(tm_hour&)),2);":";
  5974.   PRINT RIGHT$("0"+STR$(lt&(tm_min&)),2);":";
  5975.   PRINT RIGHT$("0"+STR$(lt&(tm_sec&)),2)
  5976. ENDIF
  5977. ' 18.10.1994 16:18:42
  5978. PROCEDURE init_time_constants_and_variables
  5979.   ' ++SYM
  5980.   ' struct tm
  5981.   LET tm_sec&=0
  5982.   LET tm_min&=1
  5983.   LET tm_hour&=2
  5984.   LET tm_mday&=3
  5985.   LET tm_mon&=4
  5986.   LET tm_year&=5
  5987.   LET tm_wday&=6
  5988.   LET tm_yday&=7
  5989.   LET tm_isdst&=8
  5990.   LET secs_per_min%=60
  5991.   LET secs_per_hour%=3600
  5992.   LET secs_per_day%=86400
  5993.   LET secs_per_year%=31536000
  5994.   LET secs_per_leapyear%=31622400
  5995.   ' ++SYM
  5996.   LET timezone_%=-1
  5997.   DIM days_per_mth&(11)
  5998.   LET days_per_mth&(0)=31
  5999.   LET days_per_mth&(1)=28
  6000.   LET days_per_mth&(2)=31
  6001.   LET days_per_mth&(3)=30
  6002.   LET days_per_mth&(4)=31
  6003.   LET days_per_mth&(5)=30
  6004.   LET days_per_mth&(6)=31
  6005.   LET days_per_mth&(7)=31
  6006.   LET days_per_mth&(8)=30
  6007.   LET days_per_mth&(9)=31
  6008.   LET days_per_mth&(10)=30
  6009.   LET days_per_mth&(11)=31
  6010.   LET dst%=-1
  6011. RETURN
  6012. PROCEDURE tz_set
  6013.   timezone_%=@tzoffset(@getenv$("TZ"),dst%)
  6014. RETURN
  6015. FUNCTION getenv$(a$)
  6016.   $F%
  6017.   LOCAL a!
  6018.   LOCAL a%
  6019.   LOCAL b$
  6020.   LOCAL trenn$
  6021.   a%=PRED({ADD(BASEPAGE,44)})
  6022.   REPEAT
  6023.     ADD a%,SUCC(LEN(b$))
  6024.     b$=CHAR{a%}
  6025.     IF INSTR(b$,a$)=1
  6026.       trenn$=MID$(b$,SUCC(LEN(a$)),1)
  6027.       IF trenn$="=" OR trenn$=" " OR trenn$=""
  6028.         a!=-1
  6029.         IF trenn$=""
  6030.           b$=""
  6031.         ELSE
  6032.           b$=MID$(b$,ADD(LEN(a$),2))
  6033.         ENDIF
  6034.       ENDIF
  6035.     ENDIF
  6036.   UNTIL b$="" OR a!
  6037.   RETURN b$
  6038. ENDFUNC
  6039. FUNCTION gmtime_(t%,VAR stm&())
  6040.   LOCAL time%
  6041.   LOCAL year&
  6042.   LOCAL mday&
  6043.   LOCAL i&
  6044.   time%=t%
  6045.   IF time%<0
  6046.     RETURN FALSE
  6047.   ENDIF
  6048.   stm&(tm_wday&)=MOD(ADD(DIV(time%,secs_per_day%),4),7)
  6049.   year&=70
  6050.     EXIT IF time%<secs_per_year%
  6051.     IF MOD(year&,4)=0
  6052.       EXIT IF time%<secs_per_leapyear%
  6053.       SUB time%,secs_per_leapyear%
  6054.     ELSE
  6055.       SUB time%,secs_per_year%
  6056.     ENDIF
  6057.     INC year&
  6058.   LOOP
  6059.   stm&(tm_year&)=year&
  6060.   stm&(tm_yday&)=DIV(time%,secs_per_day%)
  6061.   mday&=stm&(tm_yday&)
  6062.   IF MOD(year&,4)
  6063.     days_per_mth&(1)=28
  6064.   ELSE
  6065.     days_per_mth&(1)=29
  6066.   ENDIF
  6067.   WHILE mday&>=days_per_mth&(i&)
  6068.     SUB mday&,days_per_mth&(i&)
  6069.     INC i&
  6070.   WEND
  6071.   stm&(tm_mon&)=i&
  6072.   stm&(tm_mday&)=SUCC(mday&)
  6073.   time%=MOD(time%,secs_per_day%)
  6074.   stm&(tm_hour&)=DIV(time%,secs_per_hour%)
  6075.   time%=MOD(time%,secs_per_hour%)
  6076.   stm&(tm_min&)=DIV(time%,secs_per_min%)
  6077.   stm&(tm_sec&)=MOD(time%,secs_per_min%)
  6078.   stm&(tm_isdst&)=0
  6079.   RETURN TRUE
  6080. ENDFUNC
  6081. FUNCTION indst(s%,VAR t&())
  6082.   IF t&(tm_mon&)=3
  6083.     IF t&(tm_year&)<87 AND SUB(ADD(t&(tm_wday&),30),t&(tm_mday&))<7
  6084.       RETURN TRUE
  6085.     ENDIF
  6086.     IF SUB(t&(tm_wday&),t&(tm_mday&))<0
  6087.       RETURN TRUE
  6088.     ENDIF
  6089.     RETURN FALSE
  6090.   ENDIF
  6091.   IF t&(tm_mon&)=9
  6092.     IF SUB(ADD(t&(tm_wday&),31),t&(tm_mday&))<7
  6093.       RETURN 0
  6094.     ENDIF
  6095.     RETURN TRUE
  6096.   ENDIF
  6097.   RETURN t&(tm_mon&)>3 AND t&(tm_mon&)<9
  6098. ENDFUNC
  6099. FUNCTION localtime(t%,VAR stm&())
  6100.   LOCAL gmsecs%
  6101.   tz_set
  6102.   gmsecs%=t%-timezone_%
  6103.   IF NOT @gmtime_(gmsecs%,stm&())
  6104.     RETURN FALSE
  6105.   ENDIF
  6106.   IF dst%=-1
  6107.     stm&(tm_isdst&)=-1
  6108.   ELSE
  6109.     stm&(tm_isdst&)=0
  6110.   ENDIF
  6111.   IF dst%=1 AND @indst(t%,stm&())
  6112.     stm&(tm_isdst&)=1
  6113.     INC stm&(tm_hour&)
  6114.     IF stm&(tm_hour&)>23
  6115.       SUB stm&(tm_hour&),24
  6116.       stm&(tm_wday&)=MOD(SUCC(stm&(tm_wday&)),7)
  6117.       INC stm&(tm_yday&)
  6118.       INC stm&(tm_mday&)
  6119.       IF stm&(tm_mday&)>days_per_mth&(stm&(tm_mon&))
  6120.         stm&(tm_mday&)=1
  6121.         INC stm&(tm_mon&)
  6122.       ENDIF
  6123.     ENDIF
  6124.   ENDIF
  6125.   RETURN TRUE
  6126. ENDFUNC
  6127. FUNCTION tzoffset(s$,VAR hasdst%)
  6128.   LOCAL off%
  6129.   LOCAL x&
  6130.   LOCAL sgn&
  6131.   LOCAL i&
  6132.   sgn&=1
  6133.   hasdst%=-1
  6134.   IF s$=""
  6135.     RETURN 0
  6136.   ENDIF
  6137.   hasdst%=0
  6138.   WHILE i&<=LEN(s$)
  6139.     INC i&
  6140.     SELECT ASC(MID$(s$,i&))
  6141.     CASE  TO 64,91 TO 96,123 TO
  6142.       EXIT IF -1
  6143.     ENDSELECT
  6144.   WEND
  6145.   s$=MID$(s$,i&)
  6146.   IF LEFT$(s$)="-"
  6147.     sgn&=-1
  6148.     s$=MID$(s$,2)
  6149.   ENDIF
  6150.   x&=VAL(s$)
  6151.   off%=MUL(x&,secs_per_hour%)
  6152.   s$=MID$(s$,SUCC(VAL?(s$)))
  6153.   IF LEFT$(s$)=":"
  6154.     s$=MID$(s$,2)
  6155.     x&=VAL(s$)
  6156.     ADD off%,MUL(x&,secs_per_minute%)
  6157.   ENDIF
  6158.   RETURN sgn&*off%
  6159. ENDFUNC
  6160. lZeitdifferenz berechnen                                       GFA-Util
  6161. Autor: Roland Skuplik @ DO2
  6162. t1$="15:58:11"
  6163. PRINT t1$
  6164. t2$="16:02:05"
  6165. PRINT t2$
  6166. t1%=@in_sekunden(t1$)
  6167. t2%=@in_sekunden(t2$)
  6168. differenz%=SUB(t2%,t1%)
  6169. PRINT differenz%'"Sekunden"
  6170. PRINT @zeit$(differenz%)
  6171. FUNCTION in_sekunden(z$)
  6172.   $F%
  6173. 2' #UMBRUCH ANFANG!
  6174.   RETURN ADD(ADD(VAL(MID$(z$,7,2)),MUL(VAL(MID$(z$,4,2)),60)),
  6175.   MUL(VAL(MID$(z$,1,2)),3600))
  6176. 0' #UMBRUCH ENDE!
  6177. ENDFUNC
  6178. FUNCTION zeit$(s%)
  6179.   RETURN
  6180. 2' #UMBRUCH ANFANG!
  6181.   RIGHT$("0"+STR$(DIV(s%,3600)),2)+":"+RIGHT$("0"+STR$(DIV(MOD
  6182.   (s%,3600),60)),2)+":"+RIGHT$("0"+STR$(MOD(MOD(s%,3600),60)),2)
  6183. 0' #UMBRUCH ENDE!
  6184. ENDFUNC
  6185. lKOBASCH - KOBold-Acc-SCHnitstelle                             GFA-Util
  6186. Autor: 
  6187.   @ AC3
  6188. MODULE KOBASCH - 
  6189. dold-
  6190. dnittstelle
  6191.     (C) 1993 
  6192.              H
  6193. ttenstr.  46
  6194.              D-52068 Aachen
  6195.     Version: 0.3 24.10.1993
  6196. 11.1 
  6197. 11.2 
  6198. 11.3 
  6199. 11.4 
  6200. lDokumentation zu KOBASCH                                      GFA-Util
  6201. eTIP's, die man beachten sollte:
  6202. Wenn man mit dem KOBOLD als 
  6203. #ACC arbeitet, sollte man den Job, der
  6204. durchgef
  6205. hrt werden soll, in Einzelschritten abarbeiten.
  6206. Grund: Ich habe des 
  6207. fteren Probleme mit Speicherjob's gehabt, wenn
  6208. sie zu lang sind.
  6209. Wie wird's also gemacht?
  6210. Zum l
  6211. schen mehrerer Dateien oder Ordner in einem Startpfad oder bei
  6212. komplexen Job's (Backup, BAK-Killer) sollte man etwa so vorgehen:
  6213. &Kobold aufrufen mit 
  6214. -k2_src_select
  6215.  Zielpfad mit 
  6216. -k2_dst_select einstellen
  6217.  Dateien oder Ordner mit 
  6218. )k2_select selektieren
  6219.  Selektierte Daten mit 
  6220. 'k2_copy kopieren oder verschieben
  6221. &Kobold-Aktionen mit kobold_close beenden
  6222. eAufgabe der Proceduren:
  6223. 'k2_init
  6224.         Sollte bei Programmstart einmal aufgerufen werden. Hier
  6225.         werden alle n
  6226. tigen Varialen deklariert und der Speicher
  6227.         (4kb) f
  6228. r den Job reserviert.
  6229. 'k2_exit
  6230.         Sollte bei Programm-Ende aufgerufen werden. Hier wird der
  6231.         Speicher f
  6232. r den Job wieder freigegeben und die
  6233.         Dimensionierung des MSG- Puffers aufgehoben.
  6234. 0k2_copy_and_quit
  6235.         Dient zum Kopieren oder Verschieben von einem Ordner bzw.
  6236.         einer Datei.
  6237. 2k2_delete_and_quit
  6238.         Dient zum L
  6239. schen eines Ordners bzw. einer Datei.
  6240. -k2_src_select
  6241.         Dient zum Ausw
  6242. hlen des Quellpfad's bzw. zum Aktivieren des
  6243.         KOBOLD.
  6244. -k2_dst_select
  6245.         Dient zum Ausw
  6246. hlen des Zielpfades.
  6247. 'k2_copy
  6248.         Dient zum Kopieren oder Verschieben der durch 
  6249. )k2_select
  6250.         selektierten Daten.
  6251. )k2_select
  6252.         Dient zum Selektieren eines/einer Ordners/Datei. Es muss
  6253.         vorher 
  6254. -k2_src_select aufgerufen worden sein.
  6255. )k2_delete
  6256.         Dient zum l
  6257. schen der mit 
  6258. )k2_select selektierten Daten.
  6259. (k2_close
  6260.         Dient zum Schliessen des 
  6261. &Kobold-Dialog's (KOBOLD-Beenden).
  6262. )k2_konfig
  6263.         Dient zum Erfragen der KOBOLD-Konfiguration. Variablen-Namen
  6264.         entsprechen der Deklaration in GERUEST.C auf der 
  6265. &Kobold-
  6266.         Diskette. Bis auf gemdos_mode sind das alles WORD-Variablen
  6267.         (&)! gemdos_mode selbst ist als String ($) abgelegt. Der
  6268.         Aufbau des Strings ist identisch mit dem Parameter beim
  6269.         Befehl GEMDOS_MODE! Angenommen LW A: und B: sind bei KOBOLD
  6270.         auf GEMDOS_MODE eingestellt. gemdos_mode$ sieht dann so aus:
  6271.             ABcdefghijklmnopqrstuvwxyz
  6272.         Merke: Laufwerke ab U: (Multitos o.
  6273. .) sollten mit KOBOLD
  6274.         'AUF JEDEN FALL' im GEMDOS_MODE benutzt werden, da sich diese
  6275.         nur 
  6276.   ansprechen lassen. Also:
  6277.             GEMDOS_MODE = (ABcdefghijklmnopqrstUVWXYZ)
  6278. )k2_dialog, 
  6279. *k2_adresse und 
  6280. 'k2_exec werden von den anderen Proceduren
  6281. aus aufgerufen. Sie brauchen nicht beachtet zu werden, d
  6282. rfen aber
  6283. auch nicht gel
  6284. scht werden!
  6285. -k2_init_texte wird in dieser Version noch nicht ben
  6286. tigt!
  6287. lBeispiel zu KOBASCH                                           GFA-Util
  6288. Autor: 
  6289.   @ AC3
  6290. ' DEMO zu KOBASCH (C) 1993 by M.Ssykor
  6291. $M5120  ! 5 Kb Speicher reservieren
  6292. '         Compiler Einstellungen
  6293. $*&     ! Longwort-Integer-Multiplikation - 'MULS'
  6294. $%3     ! Longwort-Integer-Division - Integer
  6295. $RC&    ! RC_INTERSECT-Parameter als 2 Byte
  6296. $I-     ! BREAK-Tasten und EVERY/AFTER-Abfrage nicht einbauen
  6297. $S<     ! SELECT/CASE auf Programml
  6298. nge optimiert
  6299. $S&     ! SELECT/CASE-Parameter im 2 Byte-Format
  6300. $E-     ! Fehlermeldungen aus
  6301. $F<     ! ENDFUNC-Zeilen ignorieren
  6302. ~GRAF_MOUSE(0,0)
  6303. ~WIND_GET(0,7,xx&,yy&,ww&,hh&)
  6304. ~FORM_DIAL(3,xx&,yy&,ww&,hh&,xx&,yy&,ww&,hh&)
  6305. GOSUB init_ofls
  6306. ' COOKIE Routine initialisieren
  6307. GOSUB 
  6308. -k2_init_texte
  6309. start$="C:\EASE\"
  6310. ' Startordner (aus dem wird eine Datei oder ein Ordner hinauskopiert)
  6311. ' Mit diesen - hinauskopierten - Daten wird dann gearbeitet. Es werden
  6312. ' also keine Daten von Dir gel
  6313. scht!
  6314. ziel$="H:\NEWS\"  ! Zielordner zum herumspielen von KOBASCH
  6315. temp$="H:\TEMP\"  ! Temporary Ordner (zum zwischenspeichern von
  6316. '                   der Datei bzw. dem Ordner)
  6317. dat$="EASE.PRG"   ! Datei oder Ordner der benutzt werden soll
  6318. ' ^^ Bitte anpassen...
  6319. GOSUB 
  6320. 'k2_init      ! Initialisieren der 
  6321. &Kobold-Routinen
  6322. ' Wie schon gesagt! DON'T PANIK!
  6323. dia!=TRUE  ! Mit KOBOLD-Dialog
  6324. al_r$="Return-Code des letzten|KOBOLD_2 Aktion!|-----------------------|"
  6325. al$="Erst mal die Datei|in den TEMP Ordner|kopieren! Ohne Dialog!"
  6326. ALERT 1,al$,1," OK ",back|
  6327. 0k2_copy_and_quit(start$,temp$,dat$,FALSE,FALSE,0)
  6328. ALERT 1,al_r$+
  6329. 'k2_err$,1," OK ",back|
  6330. ALERT 1,"Mit Dialog und abfragen!",1," OK ",back|
  6331. 0k2_copy_and_quit(temp$,ziel$,dat$,FALSE,dia!,2)
  6332. ALERT 1,al_r$+
  6333. 'k2_err$,1," OK ",back|
  6334. 2k2_delete_and_quit(ziel$,dat$,dia!,2)
  6335. ALERT 1,al_r$+
  6336. 'k2_err$,1," OK ",back|
  6337. ALERT 1,"Mit Dialog aber|ohne abfragen!",1," OK ",back|
  6338. 0k2_copy_and_quit(temp$,ziel$,dat$,FALSE,dia!,0)
  6339. ALERT 1,al_r$+
  6340. 'k2_err$,1," OK ",back|
  6341. 2k2_delete_and_quit(ziel$,dat$,dia!,0)
  6342. ALERT 1,al_r$+
  6343. 'k2_err$,1," OK ",back|
  6344. ALERT 1,"Ohne Dialog und|ohne abfragen!",1," OK ",back|
  6345. dia!=FALSE
  6346. 0k2_copy_and_quit(temp$,ziel$,dat$,TRUE,dia!,0)
  6347. ALERT 1,al_r$+
  6348. 'k2_err$,1," OK ",back|
  6349. 2k2_delete_and_quit(ziel$,dat$,dia!,0)
  6350. ALERT 1,al_r$+
  6351. 'k2_err$,1," OK ",back|
  6352. ALERT 1,"Das war's schon!",1," OK ",back|
  6353. 'k2_exit
  6354. ' ENDE der DEMONSTRATION
  6355. lModule OFLS                                                   GFA-Util
  6356. Autor: 
  6357.   @ AC3
  6358. ' MODULE OFLS - check Open FiLeS
  6359. ' by 
  6360. *Claus Brod (f
  6361. r die KOBOLD-Routinen 
  6362. berarbeitet 23.10.93 von M.Ssykor)
  6363. ' Dieses Modul schaut nach, ob das Programm CHK_OFLS.PRG installiert
  6364. ' ist, bzw. ob der Cookie OFLS vorhanden ist.
  6365. ' Somit kann man nun 
  6366. berpr
  6367. fen, ob auf einem Laufwerk Dateien ge
  6368. ffnet
  6369. ' sind. Zum Beispiel, wenn man mittels KOBOLD_2 Daten l
  6370. schen m
  6371. chte.
  6372. ' Dort kann dann von vorne herein auf 
  6373.  -Modus umgeschaltet werden.
  6374. > PROCEDURE init_ofls
  6375.   LOCAL a$
  6376.   a$=MKL$(&H202F0004)+MKL$(&H48E77FFE)+MKL$(&H260042A7)
  6377.   a$=a$+MKL$(&H3F3C0020)+MKL$(&H4E412F40)+MKL$(&H22079)
  6378.   a$=a$+MKL$(&H5A0)+MKL$(&H670C2218)+MKL$(&H2018B283)+MKL$(&H67064A81)
  6379.   a$=a$+MKL$(&H66F47000)+MKL$(&H26004E41)+MKL$(&H5C8F2003)
  6380.   a$=a$+MKL$(&H4CDF7FFE)+MKI$(&H4E75)
  6381.   cookie_adr%=V:a$
  6382.   ' Assembler Routine, um einen Cookie zu suchen
  6383.   DEFFN cookie(cookie$)=C:cookie_adr%(L:CVL(cookie$))
  6384. RETURN
  6385. > FUNCTION chk_ofls$(start$)    ! Datei_offen_
  6386. berwacher installiert?
  6387.   SELECT @ofls(ASC(LEFT$(start$,1))-65)
  6388.   CASE -1
  6389.     ' OFLS.PRG nicht installiert...                      GEMDOS_MODE
  6390.     ext$=" GEMDOS_MODE = ("+UPPER$(LEFT$(start$,1))+") "
  6391.   CASE 1 TO 999999
  6392.     ' offene Dateien auf Laufwerk..                      GEMDOS_MODE
  6393.     ext$=" GEMDOS_MODE = ("+UPPER$(LEFT$(start$,1))+") "
  6394.   DEFAULT
  6395.     ' OFLS inst und keine offenen Dateien...             KOBOLD_MODE
  6396.     ext$=" "
  6397.   ENDSELECT
  6398.   RETURN ext$   ! Teiljob zur
  6399. ckliefern
  6400. ENDFUNC
  6401. > FUNCTION ofls(drv%)     ! Gibt Anzahl offener Dateien von LW drv% zur
  6402.   IF @
  6403. 'cookie("OFLS")>0
  6404.     RETURN DPEEK(@
  6405. 'cookie("OFLS")+6+drv%*2)
  6406.   ENDIF
  6407.   ' Wenn OFLS.PRG nicht installiert wird -1 geliefert
  6408.   RETURN -1
  6409. ENDFUNC
  6410. ' --- END-MODULE-OFLS ---
  6411. lModule KOBASCH                                                GFA-Util
  6412. Autor: 
  6413.   @ AC3
  6414. MODULE KOBASCH - 
  6415. dold-
  6416. dnittstelle
  6417. ' (C) von 
  6418. ' Version: 0.3 24.10.1993
  6419. > PROCEDURE k2_init
  6420.   ' Bei Programmstart
  6421.   adr%=MALLOC(512)
  6422.   DIM msg&(7)
  6423.   ' Eigene ID
  6424.   ap_id&=APPL_INIT()
  6425. &Kobold 2 ID
  6426.   k2_id&=APPL_FIND("KOBOLD_2")
  6427.   ' Kobold_2 
  6428. +Nachrichten
  6429.   k2_job&=12048
  6430.   k2_job_no_window&=12049
  6431.   k2_answer&=12050
  6432.   k2_konfig&=12051
  6433.   k2_close&=12054
  6434. RETURN
  6435. > PROCEDURE k2_exit
  6436.   ' Bei Programmende
  6437.   ' Speicher f
  6438. r JOB freigeben!
  6439.   ~MFREE(adr%)
  6440. RETURN
  6441. > PROCEDURE k2_copy_and_quit(start$,ziel$,dat$,move!,dia!,dialog_level&)
  6442.   ' Eine Datei bzw. Ordner Kopieren oder Verschieben
  6443.   ' ^^^^
  6444.   ' move!   = TRUE  = Daten verschieben
  6445.   ' move!   = FALSE = Daten kopieren
  6446.   ' dia! = TRUE  = mit KOBOLD-Dialog
  6447.   ' dia! = FALSE = ohne KOBOLD-Dialog
  6448.   ' JOB generieren
  6449.   job$="DIALOG_LEVEL = "+STR$(dialog_level&)+" DST_SELECT "+ziel$
  6450.   job$=job$+" SRC_SELECT "+start$+" SRC_SELECT +"+dat$+" "
  6451.   IF move!=TRUE
  6452.     job$=job$+"MOVE IGNORE_WP "
  6453.   ELSE
  6454.     job$=job$+"COPY "
  6455.   ENDIF
  6456.   ' JOB in den Reservierten Speicherbereich kopieren!
  6457.   GOSUB k2_adresse(job$)
  6458.   IF dia!=TRUE
  6459.     msg&(0)=k2_job&           !MIT KOBOLD-Dialog
  6460.   ELSE
  6461.     msg&(0)=k2_job_no_window& !OHNE KOBOLD-Dialog
  6462.   ENDIF
  6463.   GOSUB k2_exec                !KOBOLD aktivieren
  6464.   GOSUB k2_close               !KOBOLD schliessen
  6465. RETURN
  6466. > PROCEDURE k2_delete_and_quit(start$,dat$,dia!,dialog_level&)
  6467.   ' Eine Datei bzw. Ordner l
  6468. schen
  6469.   ' ^^^^
  6470.   ' dia! = wie bei k2_copy
  6471.   ' flag!   = TRUE  = Dialog nach beendung entfernen
  6472.   ' flag!   = FALSE = Dialog nach beendung stehen lassen
  6473.   ' JOB generieren
  6474.   job$="DIALOG_LEVEL = "+STR$(dialog_level&)+" SRC_SELECT "
  6475.   job$=job$+start$+" SRC_SELECT +"+dat$+" DELETE IGNORE_WP "
  6476.   ' JOB in den Reservierten Speicherbereich kopieren!
  6477.   GOSUB k2_adresse(job$)
  6478.   GOSUB k2_dialog(dia!)
  6479.   GOSUB k2_exec
  6480.   GOSUB k2_close
  6481. RETURN
  6482. > PROCEDURE k2_src_select(start$,dia!)
  6483.   ' Quellpfad w
  6484. hlen bzw. KOBOLD aktivieren
  6485.   ' dia! = wie bei k2_copy
  6486.   ' flag!   = TRUE  = Dialog nach beendung entfernen
  6487.   ' flag!   = FALSE = Dialog nach beendung stehen lassen
  6488.   LOCAL ofls%
  6489.   ' JOB generieren
  6490.   job$="DIALOG_LEVEL = 0"+@chk_ofls$(start$)+"SRC_SELECT "+start$+" "
  6491.   ' JOB in den Reservierten Speicherbereich kopieren!
  6492.   GOSUB k2_dialog(dia!)
  6493.   GOSUB k2_adresse(job$)
  6494.   GOSUB k2_exec
  6495. RETURN
  6496. > PROCEDURE k2_dst_select(dat$,dia!)
  6497.   ' Zielpfad w
  6498.   ' JOB generieren
  6499.   job$="DST_SELECT +"+dat$+" "
  6500.   ' JOB in den Reservierten Speicherbereich kopieren!
  6501.   GOSUB k2_dialog(dia!)
  6502.   GOSUB k2_adresse(job$)
  6503.   GOSUB k2_exec
  6504. RETURN
  6505. > PROCEDURE k2_select(dat$,dia!)
  6506.   ' Datei oder Ordner im Quellpfad selektieren
  6507.   ' JOB generieren
  6508.   job$="SRC_SELECT +"+dat$+" "
  6509.   ' JOB in den Reservierten Speicherbereich kopieren!
  6510.   GOSUB k2_dialog(dia!)
  6511.   GOSUB k2_adresse(job$)
  6512.   GOSUB k2_exec
  6513. RETURN
  6514. > PROCEDURE k2_copy(dia!,move!)
  6515.   ' Selectierte von Quellpfad nach Zielpfad kopieren oder verschieben
  6516.   ' JOB generieren
  6517.   IF move!=TRUE
  6518.     job$=job$+"MOVE IGNORE_WP "
  6519.   ELSE
  6520.     job$=job$+"COPY "
  6521.   ENDIF
  6522.   ' JOB in den Reservierten Speicherbereich kopieren!
  6523.   ' und MSG 2-4 belegen!
  6524.   GOSUB k2_adresse(job$)
  6525.   GOSUB k2_dialog(dia!)
  6526.   GOSUB k2_exec
  6527. RETURN
  6528. > PROCEDURE k2_delete(dia!)
  6529.   ' Selectierte im Quellpfad l
  6530. schen
  6531.   ' JOB generieren
  6532.   job$="DIALOG_LEVEL = 0 DELETE IGNORE_WP "
  6533.   ' JOB in den Reservierten Speicherbereich kopieren!
  6534.   ' und MSG 2-4 belegen!
  6535.   GOSUB k2_dialog(dia!)
  6536.   GOSUB k2_adresse(job$)
  6537.   GOSUB k2_exec
  6538. RETURN
  6539. > PROCEDURE k2_close
  6540.   ' KOBOLD beenden
  6541.   msg&(0)=k2_close&
  6542.   msg&(1)=ap_id&
  6543.   msg&(2)=0
  6544.   msg&(3)=0
  6545.   ' Abschicken
  6546.   ~APPL_WRITE(k2_id&,16,V:msg&(0))
  6547.     ~EVNT_MESAG(V:msg&(0))      ! Auf Antwort warten
  6548.   LOOP UNTIL msg&(0)=k2_answer&
  6549.   status&=msg&(3)
  6550.   k2_err$=@k2_err$(status&)
  6551. RETURN
  6552. Nachfolgene Routinen werden von den oben genannten aufgerufen. Sind
  6553. also f
  6554. r den Anwender uninterressant, d
  6555. rfen aber NICHT gel
  6556. werden.
  6557. > PROCEDURE k2_dialog(flag!)    ! Wird ein DIALOG erw
  6558. nscht?
  6559.   ' flag!=TRUE  = Alle Aktionen mit 
  6560. &Kobold-Dialog
  6561.   ' flag!=FALSE =  "      "     ohne  "     "
  6562.   IF flag!=TRUE
  6563.     msg&(0)=k2_job&
  6564.   ELSE
  6565.     msg&(0)=k2_job_no_window&
  6566.   ENDIF
  6567. RETURN
  6568. > PROCEDURE k2_adresse(job$)    ! Job in Reservierten Bereich kopieren
  6569.   CHAR{adr%}=job$
  6570.   msg&(2)=0                     ! Muss 0 sein!
  6571.   msg&(3)=WORD(SWAP(adr%))      ! 
  6572. 'Adresse der Commandline
  6573.   msg&(4)=WORD(adr%)            ! ...im Motoroller-Format
  6574.   msg&(5)=0                     ! Muss 0 sein!
  6575. RETURN
  6576. > PROCEDURE k2_exec          ! Nachricht an KOBOLD abschicken
  6577.   msg&(1)=ap_id&             ! Eigene ID (ist immer in MSG(1))
  6578.   ' Abschicken
  6579.   ~APPL_WRITE(k2_id&,16,V:msg&(0))! Nachricht an's Hauptprogramm senden
  6580.     ~EVNT_MESAG(V:msg&(0))          ! Auf Antwort warten
  6581.   LOOP UNTIL msg&(0)=k2_answer&     ! Bis Antwort=k2_answer&
  6582.   ' RETURN-CODE von 
  6583. &Kobold
  6584.   status&=msg&(3)
  6585.   ' 0, wenn OK | <>0 wenn Fehler aufgetreten
  6586.   ' (der Wert ist die Fehlernummer)
  6587.   ' ALERT 1,STR$(status&),1,"OK",b|
  6588.   zeile&=msg&(4)
  6589.   ' Wenn status& <>0 (also bei einem Fehler) steht hier die Zeile der
  6590.   ' fehlerhaften Stelle in der *.KBJ Datei. Nur bei JOB-Dateien. Nicht
  6591.   ' aber bei Speicherjob's (Da ist es ja eh nur eine Zeile)
  6592.   k2_err$=@k2_err$(status&)
  6593. RETURN
  6594. > FUNCTION k2_err$(status&)
  6595.   ' Gibt Fehlermeldung status& als Text zur
  6596.   SELECT status&
  6597.   CASE -1
  6598.     RETURN "FINISHED"
  6599.   CASE 0
  6600.     RETURN "OK"
  6601.   CASE 0
  6602.     RETURN "ERROR"
  6603.   CASE 0
  6604.     RETURN "NO_MEMORY"
  6605.   CASE 0
  6606.     RETURN "USER_BREAK"
  6607.   CASE 0
  6608.     RETURN "INVALID_POINTER"
  6609.   CASE 0
  6610.     RETURN "LOW_BUFFER"
  6611.   CASE 0
  6612.     RETURN "WRONG_DRIVE"
  6613.   CASE 0
  6614.     RETURN "WRONG_PARAMETER"
  6615.   CASE 0
  6616.     RETURN "UNEXPECTED_COMMAND"
  6617.   CASE 0
  6618.     RETURN "INVALID_MEMSIZE"
  6619.   CASE 0
  6620.     RETURN "NO_SUCH_OBJECT"
  6621.   CASE 0
  6622.     RETURN "NO_DRIVE_SELECTED"
  6623.   CASE 0
  6624.     RETURN "NO_FOLDER_CREATION"
  6625.   CASE 0
  6626.     RETURN "WRITE_PROTECTION"
  6627.   CASE 0
  6628.     RETURN "LOW_SPACE"
  6629.   CASE 0
  6630.     RETURN "LOW_ROOT"
  6631.   CASE 0
  6632.     RETURN "INVALID_PATH"
  6633.   CASE 0
  6634.     RETURN "BUFFER_IN_USE"
  6635.   CASE 0
  6636.     RETURN "BAD_BPB"
  6637.   CASE 0
  6638.     RETURN "BAD_READ"
  6639.   CASE 0
  6640.     RETURN "BAD_WRITE"
  6641.   CASE 0
  6642.     RETURN "UNKNOWN_COMMAND"
  6643.   CASE 0
  6644.     RETURN "NO_WINDOW"
  6645.   CASE 0
  6646.     RETURN "TOO_MANY_GOSUBS"
  6647.   CASE 0
  6648.     RETURN "TOO_MANY_RETURNS"
  6649.   CASE 0
  6650.     RETURN "LABEL_NOT_FOUND"
  6651.   CASE 0
  6652.     RETURN "NO_SUCH_FOLDER"
  6653.   CASE 0
  6654.     RETURN "REORGENIZED_MEMORY"
  6655.   CASE 0
  6656.     RETURN "SELECTION_MODE"
  6657.   DEFAULT
  6658.     RETURN "UNKNOWN_ERROR"
  6659.   ENDSELECT
  6660. ENDFUNC
  6661. > PROCEDURE k2_init_texte       ! Liest die Jobbefehle in ein ARRAY
  6662.   RESTORE k2_commands
  6663.   ERASE k2_job$()
  6664.   DIM k2_job$(54)
  6665.   FOR i%=0 TO 54
  6666.     READ a$
  6667.     k2_job$(i%)=a$
  6668.   NEXT i%
  6669.   ' Job Kommandos von 0 bis 54
  6670.   k2_commands:
  6671.   DATA SRC_SELECT,DST_SELECT,DIALOG_LEVEL,KEEP_FLAGS,IGNORE_WP,ALERT,PAUSE
  6672.   DATA NEW_FOLDER,CHOOSE,RESET_STATUS,READ_INTO_BUFFER,WRITE_BUFFER,COPY
  6673.   DATA MOVE,DELETE,QUIT,GOTO,GOSUB,RETURN,PERMANENT,MEMORY,VERIFY,DATE
  6674.   DATA ARCHIVE_TREATMENT,GEMDOS_MODE,FORMAT_PARAMETER,FORMAT,SOFT_FORMAT
  6675.   DATA OFF,ON,EVER_OFF,EVER_ON,CONSIDER_PATHS,ON_LEVEL,EXTENSIONS,ARCHIVE
  6676.   DATA FILE,KEEP_SEQUENCE,RESET_ARCHIVES,OPEN_FOLDERS,CURRENT,KEEP,SET
  6677.   DATA CLEAR,CLEARED,SI,SE,DI,DE,ST,TT,CLEAR_BUFFER,SOURCE_TREATMENT
  6678.   DATA DIALOG_WINDOWS,RENAME
  6679. RETURN
  6680. > PROCEDURE k2_konfig           ! noch nicht implementiert
  6681.   LOCAL a%,a$
  6682.   msg&(0)=k2_konfig&
  6683.   msg&(1)=ap_id&                ! Applikations-ID des eigenen Programms
  6684.   msg&(2)=0
  6685.   msg&(3)=WORD(SWAP(adr%))      ! 
  6686. 'Adresse der Commandline
  6687.   msg&(4)=WORD(adr%)            ! ...im Motoroller-Format
  6688.   msg&(5)=0
  6689.   ' Abschicken
  6690.   ~APPL_WRITE(k2_id&,16,V:msg&(0))
  6691.     ~EVNT_MESAG(V:msg&(0))      ! Auf Antwort warten
  6692.   LOOP UNTIL msg&(0)=k2_answer&
  6693.   GOSUB k2_close
  6694.   min_buffer&=WORD{adr%}            ! Eingestellte Speichergrenzen (in KB)
  6695.   max_buffer&=WORD{adr%+2}
  6696.   min_admin&=WORD{adr%+4}
  6697.   max_admin&=WORD{adr%+6}
  6698.   admin_percent&=WORD{adr%+8}       ! Prozentanteil des Verwaltungsspeichers
  6699.   buffer_in_fast_ram&=WORD{adr%+10}  ! Lage der Speicherbereiche
  6700.   admin_in_fast_ram&=WORD{adr%+12}  ! 0 = ST-Ram, 1 = Fast-Ram
  6701.   admin&=WORD{adr%+14}              ! Freier Verwaltungsspeicher zum Zeitpunkt der Abfrage
  6702.   buffer&=WORD{adr%+16}             ! Freier Dateipuffer zum Zeitpunkt der Abfrage
  6703.   k2_sleeping&=WORD{adr%+18}        ! 0 = KOBOLD aktiv, 1 = KOBOLD inaktiv
  6704.   k2_dialog&=WORD{adr%+20}          ! 0 = keine Hauptdialoganzeige, 1 = Hauptformular offen
  6705.   no_of_files&=WORD{adr%+22}        ! Anzahl der im Quellaufwerk selektierten Dateien
  6706.   no_of_folders&=WORD{adr%+24}      ! Anzahl der im Quellaufwerk selektierten Ordner
  6707.   total_kb&=WORD{adr%+26}           ! Auswahlumfang in Kilobytes
  6708.   source_drive&=WORD{adr%+28}       ! Quellaufwerk, -1 = Keins
  6709.   dest_drive&=WORD{adr%+30}         ! Ziellaufwerk, -1 = Keins
  6710.   a$=SPACE$(4)
  6711.   BMOVE adr%+33,V:a$,4
  6712.   a%={V:a$}
  6713.   a$=BIN$(a%,32)
  6714.   FOR i%=2 TO 27
  6715.     IF MID$(a$,i%,1)="0"
  6716.       MID$(a$,i%,1)=CHR$(i%+95)
  6717.     ELSE
  6718.       MID$(a$,i%,1)=CHR$(i%+63)
  6719.     ENDIF
  6720.   NEXT i%
  6721.   gemdos_mode$=MID$(a$,2,26)
  6722.   ' PRINT "MIN-BUFFER: "+STR$(min_buffer&)
  6723.   ' PRINT "
  6724. #MAX-BUFFER: "+STR$(max_buffer&)
  6725.   ' PRINT "MIN-ADMIN: "+STR$(min_admin&)
  6726.   ' PRINT "
  6727. #MAX-ADMIN: "+STR$(max_admin&)
  6728.   ' PRINT "ADMIN- % : "+STR$(admin_percent&)
  6729.   ' PRINT "BUFFER in FAST RAM: "+STR$(buffer_in_fast_ram&)
  6730.   ' PRINT "ADMIN in FAST RAM: "+STR$(admin_in_fast_ram&)
  6731.   ' PRINT "ADMIN: "+STR$(admin&)
  6732.   ' PRINT "BUFFER: "+STR$(buffer&)
  6733.   ' PRINT "K2 SLEEPING: "+STR$(k2_sleeping&)
  6734.   ' PRINT "K2 DIALOG: "+STR$(k2_dialog&)
  6735.   ' PRINT "NO OF FILES: "+STR$(no_of_files&)
  6736.   ' PRINT "NO OF FOLDERS: "+STR$(no_of_folders&)
  6737.   ' PRINT "TOTAL_KB: "+STR$(total_kb&)
  6738.   ' PRINT "SOURCE-DRIVE: "+STR$(source_drive&)
  6739.   ' PRINT "DEST-DRIVE: "+STR$(dest_drive&)
  6740.   ' PRINT "
  6741.  -MODE: "+gemdos_mode$
  6742. RETURN
  6743. ' --- END MODULE KOBASCH ---
  6744. lProzess-Balken zeichnen                                       GFA-Util
  6745. Prozess-Balken 
  6746.  la CAT? Kein Problem! Die nachfolgenden Listings
  6747. zeigen, wie es geht. Das zugeh
  6748. rige RSC-File ist UUEncoded unter
  6749.   zu finden.
  6750. lAnm:
  6751. d Mit der grafischen Darstellung eines lang andauernden Prozesses
  6752. (wie z.B. Laden einer Datei oder Errechnen komplexer Funktionen) ist
  6753. meist auch mit einer (mehr oder minder) geringer Geschwindigkeits-
  6754. einbu
  6755. e zu rechnen. Hier solltest Du einen Kompromi
  6756.  zwischen
  6757. Programmschnelligkeit und -information finden.
  6758. re es unter Umst
  6759. nden m
  6760. glich, nur alle 10 Schleifendurchl
  6761. die entsprechende Prozess-Routine aufzurufen:
  6762. FOR i&=0 to anzahl_schleifendurchlaeufe&
  6763.  IF i& MOD 10 = 0
  6764.   prozess()
  6765.  ENDIF
  6766.  [...]
  6767.  @rechnen, laden, etc.
  6768.  [...]
  6769. NEXT i&
  6770. 12.1 
  6771. 12.2 
  6772. 12.3 
  6773. lProzess-Balken (nach Pomrehn)                                 GFA-Util
  6774. Autor: Ingo Pomrehn @ DU
  6775. PROCEDURE prozess_balken(text$,soll%,ist%)
  6776.   ~RSRC_GADDR(0,pbaum&,ptree%)                 ! 
  6777. 'Adresse ermitteln
  6778.   ~FORM_CENTER(ptree%,px%,py%,pw%,ph%)         ! Zentrieren
  6779.   IF prozess_balken!=FALSE AND text$<>" "      ! Wird der Balken zum ersten Mal aufgerufen?
  6780.     ~WIND_UPDATE(1)
  6781.     ~WIND_UPDATE(3)
  6782.     ~FORM_DIAL(0,0,0,0,0,px%,py%,pw%,ph%)      ! Reservieren
  6783.     OB_X(ptree%,pbalken&)=0                    ! Balken links
  6784.     OB_W(ptree%,pbalken&)=0                    ! und Balken ganz klein
  6785.     ueberschrift$=SPACE$(30)
  6786.     text$=LEFT$(text$,28)
  6787.     MID$(ueberschrift$,15-LEN(text$)/2,LEN(text$))=text$
  6788.     CHAR{{OB_SPEC(ptree%,ptext&)}}=LEFT$(ueberschrift$,30)  ! 
  6789. berschrift
  6790.                                                             ! einsetzen
  6791.     ~OBJC_DRAW(ptree%,0,7,px%,py%,pw%,ph%)     ! Box zeichnen
  6792.     prozess_balken!=TRUE
  6793.   ELSE
  6794.     IF ist%<soll% AND prozess_balken!=TRUE     ! Balken kann noch wachsen
  6795.       max%=OB_W(ptree%,pgrund&)                ! maximale Gr
  6796.       breite%=ROUND(max%/soll%*ist%)           ! Breite berechnen
  6797.       IF breite%>0 AND breite%<max%
  6798.         OB_W(ptree%,pbalken&)=breite%                 ! Breite setzen
  6799.         ~OBJC_DRAW(ptree%,pbalken&,7,px%,py%,pw%,ph%) ! Rahmen neu zeichnen
  6800.       ENDIF
  6801.     ELSE IF ist%=soll% AND prozess_balken!=TRUE ! Balken hat volle Gr
  6802.       ~FORM_DIAL(3,0,0,0,0,px%,py%,pw%,ph%)     ! erreicht Dialog wird ab-
  6803.       ~WIND_UPDATE(0)                           ! gebrochen.
  6804.       ~WIND_UPDATE(2)
  6805.       prozess_balken!=FALSE
  6806.     ENDIF
  6807.   ENDIF
  6808. RETURN
  6809. lProzess-Balken (nach R
  6810. ger)                                   GFA-Util
  6811. Autor: Frank R
  6812. ger @ OS2
  6813. Die Variable balken_w_max& ist die Breite der den Balken umgebenden
  6814. Box! Diese mu
  6815. t Du irgendwo global definieren oder in der Procedure
  6816. abfragen! istwert& und maxwert& sind die aktuellen Werte der Daten,
  6817. die der Laufbalken wiederspiegeln soll. Ist maxwert&>0 wird der
  6818. Laufbalken berechnet und neu gezeichnet, was -1 und 0 bewirken,
  6819. siehst Du ja! SCALE(x&,y&,z&) ist eine selten dokumentierte GFA-
  6820. Funktion, die den Wert MUL(x&,DIV(y&,z&)) liefert und f
  6821. r Slider-
  6822. /Balkenpositionsberechnungen genau das Richtige ist!
  6823. PROCEDURE prozess_balken(istwert&,maxwert&)
  6824.  SELECT maxwert&    !wird hier gleich zur Steuerung mi
  6825. braucht:-)
  6826.  CASE -1    !Start
  6827.   ~RSRC_GADDR(0,pbaum&,tree%)
  6828.   ~FORM_CENTER(tree%,x&,y&,w&,h&)
  6829.   ~FORM_DIAL(0,0,0,0,0,x&,y&,w&,h&)
  6830.   OB_W(tree%,pbalken&)=0
  6831.   ~OBJC_DRAW(tree%,0,8,x&,y&,w&,h&)
  6832.  CASE 0     !Finish
  6833.   ~FORM_DIAL(3,0,0,0,0,x&,y&,w&,h&)
  6834.  DEFAULT    !Process
  6835.   OB_W(tree%,pbalken&)=SCALE(balken_w_max&,istwert&,
  6836. #MAX(1,maxwert&))
  6837.   ~OBJC_DRAW(tree%,pbalken&,1,x&,y&,w&,h&)
  6838.  ENDIF
  6839. RETURN
  6840. lProzess-Balken f
  6841. r die FLY-DIALS                              GFA-Util
  6842.   noch einmal f
  6843. r die FLY-DIALS von Gregor
  6844. Duchalski:
  6845. PROCEDURE prozess_balken(istwert&,maxwert&)
  6846.  SELECT maxwert&    !wird hier gleich zur Steuerung mi
  6847. braucht:-)
  6848.  CASE -1                             ! Start
  6849.   OB_W(rsc_adr%(tree%),pbalken&)=0   ! Objektbreite auf Null setzen
  6850.   @rsc_draw(tree%,&X100)             ! Dialog sofort zeichnen
  6851.  CASE 0                              ! Ende
  6852.   @rsc_back(tree%)                   ! Hintergrund restaurieren
  6853.  DEFAULT                             ! Process
  6854.   OB_W(tree%,pbalken&)=SCALE(balken_w_max&,istwert&,
  6855. #MAX(1,maxwert&))
  6856.   @redraw(tree%,pbalken&)            ! Slider neuzeichnen
  6857.  ENDIF
  6858. RETURN
  6859. lDiverses                                                      GFA-Util
  6860. 13.1 
  6861. 13.2 
  6862. 13.3 
  6863. 13.4 
  6864. 13.5 
  6865. 13.6 
  6866. 13.7 
  6867. 13.8 
  6868. 13.9 
  6869. 13.10 
  6870. 13.11 
  6871. 13.12 
  6872. 13.13 
  6873. 13.14 
  6874. 13.15 
  6875. 13.16 
  6876. 13.17 
  6877. 13.18 
  6878. 13.19 
  6879. 13.20 
  6880. 13.21 
  6881. 13.22 
  6882. 13.23 
  6883. 13.24 
  6884. 13.25 
  6885. 13.26 
  6886. 13.27 
  6887. 13.28 
  6888. 13.29 
  6889. 13.30 
  6890. 13.31 
  6891. 13.32 
  6892. 13.33 
  6893. 13.34 
  6894. 13.35 
  6895. 13.36 
  6896. 13.37 
  6897. 13.38 
  6898. 13.39 
  6899. 13.40 
  6900. 13.41 
  6901. 13.42 
  6902. lErmitteln, ob das Programm im Interpreter gestartet wurde     GFA-Util
  6903. Autor: 
  6904. 0Gregor Duchalski @ DO
  6905. ' Ermittelt, ob das Programm im Interpreter (FALSE)
  6906. ' oder compiliert (TRUE) gestartet wurde...
  6907. DEFFN comp=BYTE{ADD(BASEPAGE,256)}<>96   ! Compiled?
  6908. lErmitteln, ob ein Programm als 
  6909. #ACC gestartet wurde            GFA-Util
  6910. Autor: 
  6911. 0Gregor Duchalski @ DO
  6912. ' Ergibt TRUE, wenn das Programm als 
  6913. #ACC gestartet wurde...
  6914. DEFFN acc=({ADD(BASEPAGE,36)}=0)         ! An 
  6915. #ACC?
  6916. uft das Programm unter MultiTOS?                            GFA-Util
  6917. Autor: 
  6918. 0Gregor Duchalski @ DO
  6919. ' Ergibt TRUE, wenn das Programm unter MultiTOS l
  6920. uft...
  6921. DEFFN mtos=INT{ADD({ADD(GB,4)},2)}<>1    ! Multitasking TOS?
  6922. lGFA-VSYSNC-Befehl ersetzen                                    GFA-Util
  6923. Autor: 
  6924. 0Gregor Duchalski @ DO
  6925. ' Ersetzt den GFA-VSYNC-Befehl...
  6926. > PROCEDURE vsync                        ! Replacement for VSYNC
  6927.   a%=
  6928. %XBIOS(2)+31250
  6929.   REPEAT
  6930.   UNTIL BYTE{&HFF8205}*65536+BYTE{&HFF8207}*256+BYTE{&HFF8209}<a%
  6931.   REPEAT
  6932.   UNTIL BYTE{&HFF8205}*65536+BYTE{&HFF8207}*256+BYTE{&HFF8209}>a%
  6933. RETURN
  6934. lSystemfehler-Routinen aus bzw. einschalten                    GFA-Util
  6935. Autor: 
  6936. 0Gregor Duchalski @ DO
  6937. ' Schaltet die Systemfehler-Routinen aus bzw. ein...
  6938. > PROCEDURE alerts_off        ! System-Alerts off
  6939.   INLINE noalert%,8
  6940.   {noalert%}=&H4CAF0001       ! Maschinencode : movem.w   $4(a7),d0
  6941.   {noalert%+4}=&H44E75        !                 rts
  6942.   IF {BASEPAGE+256}<>noalert% ! Um Alertbox nur einmal auszuschalten
  6943.    {BASEPAGE+256}=LPEEK(1028) ! alten Wert von CEH merken
  6944.    SLPOKE 1028,noalert%       ! neue Routine installieren
  6945.   ENDIF
  6946. RETURN
  6947. > PROCEDURE alerts_on         ! System-Alerts on
  6948.   IF BYTE{BASEPAGE+256}=0     ! Nur anschalten, wenn ausgeschaltet war
  6949.    SLPOKE 1028,{BASEPAGE+256} ! alte 
  6950. 'Adresse restaurieren
  6951.    {BASEPAGE+256}=-1          ! Einschaltung kennzeichnen
  6952.   ENDIF
  6953. RETURN
  6954. lTastaturpuffer l
  6955. schen                                        GFA-Util
  6956. Autor: 
  6957. 0Gregor Duchalski @ DO
  6958. ' Tastatur-Puffer l
  6959. schen...
  6960. LPOKE 
  6961. %XBIOS(14,1)+6,0                    ! Clear keyboard-puffer
  6962. lTOS-Version und -Datum ermitteln                              GFA-Util
  6963. Autor: 
  6964. 0Gregor Duchalski @ DO
  6965. ' Tos-Version und -Datum ermitteln...
  6966. > FUNCTION tos_version$                  ! Inquiring TOS-version
  6967.   a%=LPEEK(&H4F2)
  6968.   a$=CHR$(ADD(48,PEEK(ADD(a%,2))))
  6969.   a$=a$+"."+CHR$(ADD(48,PEEK(ADD(a%,4))))+CHR$(ADD(48,PEEK(ADD(a%,3))))
  6970.   RETURN a$
  6971. ENDFUNC
  6972. > FUNCTION tos_datum$                    ! Inquiring TOS-date
  6973.   a%=LPEEK(&H4F2)
  6974.   a$=CHR$(48+SHR(PEEK(a%+&H19),4))
  6975.   a$=a$+CHR$(48+(PEEK(a%+&H19) AND &HF))
  6976.   a$=a$+"."+CHR$(48+SHR(PEEK(a%+&H18),4))
  6977.   a$=a$+CHR$(48+(PEEK(a%+&H18) AND &HF))
  6978.   a$=a$+"."+CHR$(48+SHR(PEEK(a%+&H1A),4))
  6979.   a$=a$+CHR$(48+(PEEK(a%+&H1A) AND &HF))
  6980.   a$=a$+CHR$(48+SHR(PEEK(a%+&H1B),4))
  6981.   a$=a$+CHR$(48+(PEEK(a%+&H1B) AND &HF))
  6982.   RETURN a$
  6983. ENDFUNC
  6984. lBASEPAGE-
  6985. 'Adresse des aktuellen Prozesses                      GFA-Util
  6986. Autor: 
  6987. 0Gregor Duchalski @ DO
  6988. ' BASEPAGE-
  6989. 'Adresse des aktuellen Prozesses...
  6990. > FUNCTION act_pd                        ! BASEPAGE of actual process
  6991.   $F%
  6992.   LOCAL a&,os%,a%
  6993.   ' Ermittelt sauber die 
  6994. 'Adresse der Basepage des aktiven Prozesses...
  6995.   os%=LPEEK(&H4F2)              ! os_header
  6996.   os%={ADD(os%,8)}              ! os_beg
  6997.   a&=INT{ADD(os%,2)}            ! os_version
  6998.   IF a&<&H102                   ! TOS 1.00...
  6999.    a&=SHR(INT{ADD(os%,&H1C)},1)! os_conf
  7000.    IF a&=4                     ! Spanisches TOS...
  7001.     a%={&H873C}
  7002.     '
  7003.    ELSE                        ! Jedes andere...
  7004.     a%={&H602C}
  7005.     '
  7006.    ENDIF
  7007.   ELSE                         ! Ab TOS 1.02...
  7008.    a%={{ADD(os%,&H28)}}        ! ...direkt auslesen
  7009.   ENDIF
  7010.   RETURN a%
  7011. ENDFUNC
  7012. lKalt- oder Warmstart durchf
  7013. hren                              GFA-Util
  7014. Autor: 
  7015. 0Gregor Duchalski @ DO
  7016. hrt einen Kalt- oder Warmstart aus...
  7017. > PROCEDURE kaltstart                    ! Coldboot
  7018.   VOID 
  7019.  (&H20,L:0)
  7020.   SLPOKE &H420,0
  7021.   SLPOKE &H426,0
  7022.   SLPOKE &H43A,0
  7023.   a%=LPEEK(&H4F2)+4
  7024.   a%=LPEEK(a%)
  7025.   CALL a%
  7026. RETURN
  7027. > PROCEDURE warmstart                    ! Warmboot
  7028.   VOID 
  7029.  (&H20,L:0)
  7030.   a%=LPEEK(&H4F2)+4
  7031.   a%=LPEEK(a%)
  7032.   CALL a%
  7033. RETURN
  7034. lKommandozeile (cmd$)                                          GFA-Util
  7035. Autor: 
  7036. 0Gregor Duchalski @ DO
  7037. ' Gibt die an das Programm 
  7038. bergebene Kommandozeile zur
  7039. ck...
  7040. ' Die Eintr
  7041. ge sind durch Spaces getrennt."
  7042. > FUNCTION kommando$                     ! Get commandline
  7043.   LOCAL a|
  7044.   a|=BYTE{ADD(BASEPAGE,128)}
  7045.   IF a|
  7046.    RETURN CHAR{ADD(BASEPAGE,129)}
  7047.   ENDIF
  7048.   RETURN ""
  7049. ENDFUNC
  7050. lINLINE 2 STRING                                               GFA-Util
  7051. Autor: 
  7052. 0Gregor Duchalski @ DO
  7053. ' Hilfreich beim Kopieren vom INLINE in einen String. 
  7054. bergeben wird
  7055. ' die INLINE-
  7056. 'Adresse und die L
  7057. nge...
  7058. > FUNCTION inline$(a%,a&)
  7059.   LOCAL a$
  7060.   a$=SPACE$(a&)
  7061.   BMOVE a%,V:a$,a&
  7062.   RETURN a$
  7063. ENDFUNC
  7064. lFarb-Register retten bzw. restaurieren                        GFA-Util
  7065. Autor: 
  7066. 0Gregor Duchalski @ DO
  7067. ' Rettet die Farb-Register bzw. restauriert sie...
  7068. > PROCEDURE save_register                ! Saving color-registers
  7069.   original_reg$=SPACE$(32)
  7070.   FOR i&=0 TO 15
  7071.    CARD{V:original_reg$+i&*2}=
  7072. %XBIOS(7,i&,-1)
  7073.   NEXT i&
  7074. RETURN
  7075. > PROCEDURE restore_register             ! Restoring color-registers
  7076.   VOID 
  7077. %XBIOS(6,L:V:original_reg$)
  7078. RETURN
  7079. lBIT-Operation                                                 GFA-Util
  7080. Autor: 
  7081. 0Gregor Duchalski @ DO
  7082. ' Setzt das Bit b& in a& in Abh
  7083. ngigkeit von c&...
  7084. DEFFN bsc(a&,b&,c&)=-MUL((c&=0),BCLR(a&,b&))-MUL((c&<>0),BSET(a&,b&))
  7085. lAufruf einer Shell                                            GFA-Util
  7086. Autor: 
  7087. 0Gregor Duchalski @ DO
  7088. ' Aufruf einer Shell (hier: Mupfel) 
  7089. ber den shell_p-vektor...
  7090. > FUNCTION shell_call(a$)
  7091.   $F%
  7092.   LOCAL a%,b%
  7093.   ' R
  7094. ckgabe: -1 Keine Shell
  7095.   '            1 MUPFEL
  7096.   '            0 Andere Shell
  7097.   a%=LPEEK(&H4F6)                      ! Shell-Einsprungsdresse
  7098.   IF a%                                ! Vorhanden...
  7099.    ' a$=MKL$({SUB(a%,12)})+MKL$({SUB(a%,8)})
  7100.    ' a$="XBRAGMNI" OR a$="XBRAMUPF"   ! Mupfel-Identifizierung
  7101.    a$=a$+CHR$(0)                      ! Kommando+Nullbyte
  7102.    b%=C:a%(L:V:a$)                    ! Kommando 
  7103. bergeben
  7104.   ENDIF
  7105.   RETURN b%
  7106. ENDFUNC
  7107. lAbfrage der Umschalttasten                                    GFA-Util
  7108. Autor: 
  7109.   @ XYZ
  7110. ' Abfrage der Umschalttasten!
  7111. ' SICHER _UND_ SCHNELL
  7112. VOID GRAF_MKSTATE(mx&,my&,mk&,key&)
  7113. ' mx& und my& ist die Position der Maus!
  7114. ' mk& ist der Status der Maustasten!
  7115. ' key&=
  7116. ' 1 = Shift-Rechts
  7117. ' 2 = Shift-Links
  7118. ' 4 = Control
  7119. ' 8 = Alternate
  7120. ' auch Kombinationen sind m
  7121. glich: z.B.
  7122. ' 3  = Linke + Rechte Shifttaste
  7123. ' 10 = Alternate + Shift-Links
  7124. ' 15 = Linke + Rechte Shifttaste + Control + Alternate
  7125. lCRC-Code berechnen                                            GFA-Util
  7126. Autor: 
  7127. 0Christoph Conrad @ AC3
  7128. > FUNCTION crc(adr%,anz%)
  7129.   ' CRC-Pruefsummenermittlung nach dem CCITT-Polynom x^16+x^12+x^5+1
  7130.   ' Es wird die 16-Bit CRC-Summe ab adr% ueber anz% Byte gebildet.
  7131.   RETURN C:
  7132.  (L:adr%,anz%)
  7133. ENDFUNC
  7134. lDebugger                                                      GFA-Util
  7135. Autor: 
  7136.   @ XYZ
  7137. TRON debugger            ! aufruf des debugger
  7138. ' Hier das Programm
  7139. PROCEDURE debugger
  7140. $BIOS(11,-1)=3          ! beide Shift-Tasten
  7141.  STOP                     ! Programmstop
  7142. ENDIF
  7143. $BIOS(11,-1)=4          ! CONTROL (Programmzeilen anzeigen)
  7144.  LPRINT TRACE$            ! programmzeile auf drucker ausgeben
  7145. ENDIF
  7146. IF BTST(
  7147. $BIOS(11,-1),3)    ! ALTERNATE (Variablenabfrage)
  7148.  PRINT AT(1,1);
  7149.  INPUT "Bitte gew
  7150. nschte DUMP-Variable eingeben : ";eingabe$
  7151.  LPRINT
  7152.  DUMP eingabe$ TO "PRN:"  ! Variablen auf drucker ausgeben
  7153.  LPRINT
  7154. ENDIF
  7155. RETURN
  7156. lAdressen von GFA-Prozeduren ermitteln                         GFA-Util
  7157. ' Adressen von GFA-Prozeduren ermitteln - 27.2.92 by Stefan Muench
  7158. ' Parameter
  7159. bergabe - 10.06.92 by Gregi Duchalski
  7160. ' von 
  7161. 0Gregor Duchalski, Baueracker 15a, 4690 Herne 1
  7162. ' eMail an GREGOR DUCHALSKI Maus DO im MausNet
  7163. ' last change 26.06.92
  7164. ' --------------------------------------------------------------
  7165. ' Mit diesen Routinen k
  7166. nnen Sie die Adressen von GFA-Prozeduren
  7167. ' ermitteln.
  7168. ' Funktioniert nur in compilierten Programmen. Der Prozedur-Aufruf
  7169.  am Anfang des Programms stehen.
  7170. test1(10,10,200,10)
  7171. help.adr%=@find_firstaddress
  7172. test1adr%=@find_nextaddress(help.adr%)
  7173. ' Hier folgt der Aufruf der Prozedur 'test1' 
  7174. ber den 'C:'-Befehl.
  7175. ' Die Parameter werden hier in der umgekehrten Reihenfolge 
  7176. bergeben!
  7177. ~C:test1adr%(100,200,100,10)
  7178. ~INP(2)
  7179. > PROCEDURE test1(x&,y&,w&,h&)
  7180.   IF test1!
  7181.     LINE x&,y&,w&,h&
  7182.   ENDIF
  7183.   test!=TRUE
  7184. RETURN
  7185. > FUNCTION find_firstaddress
  7186.   $F%
  7187.   ' Sucht die 1. 
  7188. 'Adresse, ab der die Prozeduren aufgerufen werden.
  7189.   ' hier befinden wir uns sicher im Programm:
  7190.   a%=BASEPAGE
  7191.   ' gesucht wird der 1. JSR xxxxxxxx (4E B9); Schrittweite Word
  7192.   WHILE WORD{a%}<>&H4EB9
  7193.     ADD a%,2
  7194.   WEND
  7195.   ' jetzt den n
  7196. chsten JSR suchen
  7197.   REPEAT
  7198.     ADD a%,2
  7199.   UNTIL WORD{a%}=&H4EB9
  7200.   RETURN a%
  7201. ENDFUNC
  7202. > FUNCTION find_nextaddress(VAR a%)
  7203.  ' Findet den n
  7204. chsten Prozeduraufruf
  7205.  ' zurueck geben wir die Zieladresse des (alten) JSR:
  7206.  b%={ADD(a%,2)}
  7207.  ' a% soll auf den n
  7208. chsten JSR zeigen:
  7209.  REPEAT
  7210.   ADD a%,2
  7211.  UNTIL WORD{a%}=&H4EB9
  7212.  ' Zieladresse des alten JSR
  7213.  RETURN b%
  7214. ENDFUNC
  7215. lPrimzahlen errechnen                                          GFA-Util
  7216. PRINT "Primzahlen von 1 - 20000"
  7217. limit&=20000
  7218. t=TIMER
  7219. DIM noprime!(20000)
  7220. current&=3
  7221. WHILE current&*current&<limit&
  7222.   FOR i&=current&*current& TO limit& STEP current&*2
  7223.     noprime!(i&)=1
  7224.   NEXT i&
  7225.   REPEAT
  7226.     ADD current&,2
  7227.   UNTIL NOT noprime!(current&)
  7228. FOR i&=3 TO limit& STEP 2
  7229.   IF noprime!(i&)
  7230.     INC count&
  7231.   ENDIF
  7232. NEXT i&
  7233. PRINT "Zeit: ";(TIMER-t)/200;" Anzahl: ";limit&/2-count&
  7234. lUmwandlung: Dezimalzahl in r
  7235. mische Zahl                      GFA-Util
  7236. zahl%=1992
  7237. GOSUB roemisch(zahl%)
  7238. PRINT r$
  7239. PROCEDURE roemisch(zahl%)
  7240.   ' wandelt eine Zahl ins r
  7241. mische Zahlensystem um
  7242.   ' R
  7243. ckgabewert in R$
  7244.   r$=""
  7245.   WHILE zahl%>=1000
  7246.     r$=r$+"M"
  7247.     zahl%=zahl%-1000
  7248.   WEND
  7249.   IF zahl%>=900
  7250.     r$=r$+"CM"
  7251.     zahl%=zahl%-900
  7252.   ENDIF
  7253.   IF zahl%>=500
  7254.     r$=r$+"D"
  7255.     zahl%=zahl%-500
  7256.   ENDIF
  7257.   IF zahl%>=400
  7258.     r$=r$+"CD"
  7259.     zahl%=zahl%-400
  7260.   ENDIF
  7261.   WHILE zahl%>=100
  7262.     r$=r$+"C"
  7263.     zahl%=zahl%-100
  7264.   WEND
  7265.   IF zahl%>=90
  7266.     r$=r$+"XC"
  7267.     zahl%=zahl%-90
  7268.   ENDIF
  7269.   IF zahl%>=50
  7270.     r$=r$+"L"
  7271.     zahl%=zahl%-50
  7272.   ENDIF
  7273.   IF zahl%>=40
  7274.     r$=r$+"XL"
  7275.     zahl%=zahl%-40
  7276.   ENDIF
  7277.   WHILE zahl%>=10
  7278.     r$=r$+"X"
  7279.     zahl%=zahl%-10
  7280.   WEND
  7281.   IF zahl%>=9
  7282.     r$=r$+"IX"
  7283.     zahl%=zahl%-9
  7284.   ENDIF
  7285.   IF zahl%>=5
  7286.     r$=r$+"V"
  7287.     zahl%=zahl%-5
  7288.   ENDIF
  7289.   IF zahl%>=4
  7290.     r$=r$+"IV"
  7291.     zahl%=zahl%-4
  7292.   ENDIF
  7293.   WHILE zahl%>=1
  7294.     r$=r$+"I"
  7295.     zahl%=zahl%-1
  7296.   WEND
  7297. RETURN
  7298. lUmwandlung: Dezimalzahl -> 'Zahlwort'                         GFA-Util
  7299. Autor: 
  7300.   @ XYZ
  7301. GOSUB init_ziffernwoerter
  7302. zahl=567899512
  7303. GOSUB zahlen_in_text(zahl)
  7304. PRINT zahlstring$
  7305. PROCEDURE zahlen_in_text(zahl)
  7306.   zahlstring$=""
  7307.   ' Millionenteil umwandeln
  7308.   teil=zahl DIV 1000000
  7309.   suffix$=" Million"
  7310.   IF teil<>0
  7311.     ' Millionen vorhanden, also umwandeln
  7312.     GOSUB umwandlung(teil)
  7313.     zahlstring$=umwandlung$
  7314.     IF teil<>1
  7315.       ' sogar mehrere Millionen, also Mehrzahl
  7316.       suffix$=suffix$+"en"
  7317.     ELSE
  7318.       ' sonst aus 'ein' 'eine' machen
  7319.       zahlstring$=zahlstring$+"e"
  7320.     ENDIF
  7321.     zahlstring$=zahlstring$+suffix$+" "
  7322.   ENDIF
  7323.   ' jetzt den Tausenderteil
  7324.   zahl=zahl MOD 1000000
  7325.   teil=zahl DIV 1000
  7326.   suffix$="tausend"
  7327.   IF teil<>0
  7328.     ' Tausender vorhanden
  7329.     GOSUB umwandlung(teil)
  7330.     zahlstring$=zahlstring$+umwandlung$+suffix$
  7331.   ENDIF
  7332.   ' jetzt den Rest unter 1000
  7333.   zahl=zahl MOD 1000
  7334.   IF zahl<>0
  7335.     ' noch Zahlen umwandeln
  7336.     GOSUB umwandlung(zahl)
  7337.     zahlstring$=zahlstring$+umwandlung$
  7338.     IF (zahl MOD 100)=1
  7339.       ' aus 'einhundertein' mache 'einhunderteins'
  7340.       zahlstring$=zahlstring$+"s"
  7341.     ENDIF
  7342.   ENDIF
  7343.   IF zahlstring$=""
  7344.     ' Zahl war Null, also String belegen
  7345.     zahlstring$="null"
  7346.   ENDIF
  7347. RETURN
  7348. PROCEDURE umwandlung(teil)
  7349.   umwandlung$=""
  7350.   ' zuerst die Stellen isolieren
  7351.   hunderter=teil DIV 100
  7352.   zehner=(teil MOD 100) DIV 10
  7353.   einer=teil MOD 10
  7354.   ' Hunderter umwandeln
  7355.   IF hunderter<>0 THEN
  7356.     umwandlung$=ziffernwort$(hunderter)+"hundert"
  7357.   ENDIF
  7358.   ' Jetzt den Rest
  7359.   IF zehner=1 THEN
  7360.     ' Zahl zwischen 10 und 19 -> Sonderf
  7361.     umwandlung$=umwandlung$+zahlwort$(einer)
  7362.   ELSE
  7363.     ' sonst Einer umwandeln
  7364.     IF einer<>0 THEN
  7365.       umwandlung$=umwandlung$+ziffernwort$(einer)
  7366.     ENDIF
  7367.     IF zehner>=2 THEN
  7368.       ' Falls Zehner vorhanden, auch diese umwandeln
  7369.       IF einer<>0 THEN
  7370.         ' aus 'zweizwanzig' wird 'zweiUNDzwanzig'
  7371.         umwandlung$=umwandlung$+"und"
  7372.       ENDIF
  7373.       umwandlung$=umwandlung$+zehnerwort$(zehner)
  7374.     ENDIF
  7375.   ENDIF
  7376. RETURN
  7377. > PROCEDURE init_ziffernwoerter
  7378.   DIM ziffernwort$(9),zahlwort$(9),zehnerwort$(9)
  7379.   RESTORE ziffernwoerter
  7380.   FOR i=1 TO 9
  7381.     READ ziffernwort$(i)
  7382.   NEXT i
  7383.   RESTORE zahlwoerter
  7384.   FOR i=0 TO 9
  7385.     READ zahlwort$(i)
  7386.   NEXT i
  7387.   RESTORE zehnerwoerter
  7388.   FOR i=2 TO 9
  7389.     READ zehnerwort$(i)
  7390.   NEXT i
  7391. RETURN
  7392. ziffernwoerter:
  7393. DATA "ein","zwei","drei","vier","f
  7394. DATA "sechs","sieben","acht","neun"
  7395. zahlwoerter:
  7396. DATA "zehn","elf","zw
  7397. lf","dreizehn","vierzehn"
  7398. DATA "f
  7399. nfzehn","sechzehn","siebzehn","achtzehn","neunzehn"
  7400. zehnerwoerter:
  7401. DATA "zwanzig","drei
  7402. ig","vierzig","f
  7403. nfzig"
  7404. DATA "sechzig","siebzig","achtzig","neunzig"
  7405. lProgrammabl
  7406. ufe zeitlich begrenzen                            GFA-Util
  7407. ' Programmbeispiel um Programmabl
  7408. ufe zeitlich zu begrenzen
  7409. ' 19.03.1992  Sandro Lucifora  f
  7410. r  TOS
  7411. GOSUB init
  7412. AFTER sec_anzahl%*200 GOSUB prg_ende        ! zeitbegrenzung
  7413. PRINT "Schreiben, solange Zeit ist !"       ! info schreiben
  7414. PRINT CHR$(27);"e"                          ! cursor einschalten
  7415.   taste$=INKEY$                             ! taste speichern
  7416.   IF taste$<>""                             ! wenn eine taste gedr
  7417.     PRINT taste$;                           ! zeichen ausgeben
  7418.   ENDIF
  7419. PROCEDURE init
  7420.   sec_anzahl%=3                             ! zeitbegrenzung in sec
  7421. RETURN
  7422. PROCEDURE prg_ende
  7423.   OUT 2,7                                       ! "pling" ausgeben
  7424.   ALERT 0," Bis hierhin und | nicht  weiter !  ",1,"Ok",wahl|
  7425.   EDIT
  7426. RETURN
  7427. lGONG ausgeben                                                 GFA-Util
  7428. Autor: 
  7429.   @ XYZ
  7430. > PROCEDURE gong
  7431.   LOCAL mx&,my&,mb&,shift&
  7432.   SOUND 1,15,#486
  7433.   WAVE 1,1,1,8000,0
  7434.   REPEAT
  7435.     ~GRAF_MKSTATE(mx&,my&,mb&,shift&)
  7436.   UNTIL mb&=0
  7437. RETURN
  7438. lxPling ausgeben                                               GFA-Util
  7439. Autor: 
  7440.   @ AC3
  7441. Ausgabe eines Pling (wie bei CHR$(7)). Es kann die Anzahl der Plings
  7442. angegeben werden. Diese klingen dann aber nicht so gr
  7443. lich wie z.B.
  7444. PRINT STRING$(CHR$(7),3)...
  7445. > PROCEDURE xpling
  7446.   anz&=3
  7447.   a$=CHR$(7)+CHR$(254)+CHR$(0)+CHR$(52)+CHR$(1)+CHR$(0)+CHR$(8)
  7448.   a$=a$+CHR$(16)+CHR$(12)+CHR$(18)
  7449.   a$=a$+STRING$(anz&,CHR$(13)+CHR$(9)+CHR$(255)+CHR$(8))+CHR$(255)+CHR$(0)
  7450. %XBIOS(32,L:V:a$)
  7451. RETURN
  7452. lZeilenz
  7453. hler (nach Ssykor)                                    GFA-Util
  7454. Autor: 
  7455.   @ AC3
  7456. FUNCTION zeilenzaehler(dat$)
  7457.   IF @exist(dat$)
  7458.     ERASE dummy$()
  7459.     DIM dummy$(50)
  7460.     OPEN "I",#1,dat$
  7461.     RECALL #1,dummy$(),50,z%
  7462.     anz_zeilen%=0
  7463.     WHILE z%
  7464.       ADD anz_zeilen%,50
  7465.       RECALL #1,dummy$(),50,z%
  7466.     WEND
  7467.     ADD anz_zeilen%,z%
  7468.     CLOSE #1
  7469.     RETURN anz_zeilen%
  7470.   ELSE
  7471.     RETURN 0
  7472.   ENDIF
  7473. ENDFUNC
  7474. lZeilenz
  7475. hler (nach Dunkel)                                    GFA-Util
  7476. Autor: 
  7477. *Ulf Dunkel @ CLP
  7478. PROCEDURE file_cntlines_init
  7479.   ' Nur einmal im Programm-Initialisierungsteil aufrufen.
  7480.   ' INLINEs handelt man 
  7481. ber HELP-Taste, wenn der Cursor
  7482.   ' auf dem Wort INLINE steht. Nach LST-Import mu
  7483.  ein INLINE
  7484.   ' grunds
  7485. tzlich nachgeladen werden!!!
  7486.   INLINE 
  7487. RETURN
  7488. FUNCTION file_cntlines(file$)
  7489.   $F%
  7490.   ' DUTY  : Pr
  7491. ft, ob und wieviele Zeilen eine angegebene Datei enth
  7492.   ' RETURN: -1, wenn nicht ein LF-Zeichen erkannt wurde, ansonsten
  7493.   '         die Anzahl Zeilen (OPTION BASE 0!!!)
  7494.   ' EXTERN file$                   !Kompletter Dateiname
  7495.   ' GLOBAL VAR gl_no_ram!          !TRUE=Datei nur "in Happen" ladbar
  7496.   LOCAL nnn%                       !Dateigr
  7497.   LOCAL backlines%                 !R
  7498. ckgabewert f
  7499. r Anzahl Zeilen
  7500.   LOCAL lines_maxlen%              !Max. erw
  7501. nschte Zeilenl
  7502.   '                                !normalerweise 32767
  7503.   LET lines_maxlen%=32768          !+SYM
  7504.   nnn%=@file_get_size(file$)       !Dateigr
  7505. e holen
  7506.   IF nnn%=0
  7507.     RETURN 0                       !Mind 1 Zeile
  7508.   ELSE IF nnn%>0
  7509.     IF nnn%>=FRE(0)                !Datei pa
  7510. t nicht in den Speicher
  7511.       gl_no_ram!=TRUE
  7512.     ENDIF
  7513.     backlines%=@file_sub_cntlines(file$,nnn%,lines_maxlen%)
  7514.     IF backlines%<0
  7515.       backlines%=PRED(nnn%\lines_maxlen%)
  7516.     ENDIF
  7517.     RETURN backlines%
  7518.   ENDIF
  7519.   RETURN -1
  7520. ENDFUNC
  7521. FUNCTION file_sub_cntlines(file$,file_len%,lines_maxlen%)
  7522.   $F%
  7523.   ' CNTLINES   (c) Werner Buthe/
  7524. *Ulf Dunkel, 29.09.94
  7525.   ' ========
  7526.   ' DUTY:   CNTLINES z
  7527. hlt in einem Speicherbereich die CHR$(10). Sollte der
  7528.   '         Abstand zwischen zwei LF >= 32768 (entspricht 32768 Zeichen+LF),
  7529.   '         wird -1 zur
  7530. ckgeben, ansonsten die Anzahl der gefundenen LF
  7531.   '         (=Zeilenanzahl).
  7532.   '         Sinn ist es, zu pr
  7533. fen, ob eine Datei Zeilen enth
  7534. lt, die > 32767
  7535.   '         Zeichen sind, da sonst die Stringverwaltung von GFA nach einem
  7536.   '         RECALL durcheinander ger
  7537.   '         Die 'b
  7538. se' Zeilenl
  7539. nge, nach der gefahndet werden soll, ist bei
  7540.   '         Offset 40 ab INLINE-Start patchbar, wobei diese um 1 wegen dem LF
  7541.   '         erh
  7542. ht werden sollte. Dieser Wert mu
  7543.  negativ angegeben werden.
  7544.   '         Parameter f
  7545. r C:-Aufruf: Speicheradresse (adr%) und L
  7546. nge (len%),
  7547.   '                                  als Langwort, also mit L:
  7548.   ' RETURN: -1, wenn zu lange Zeilen enthalten sind oder Speicher zu klein,
  7549.   '         sonst Anzahl Zeilen (OPTION BASE 0)
  7550.   ' EXTERN file$                !Kompletter Dateiname
  7551.   ' EXTERN file_len%            !Dateigr
  7552. e in BYTE
  7553.   ' EXTERN lines_maxlen%        !Max. erlaubte Zeilenl
  7554. nge, 
  7555. blicherweise 32767
  7556.   ' LOCAL buff|()               !Puffer f
  7557. r Dateiteile
  7558.   ' GLOBAL 
  7559.              !CNTLINES-Routine (c) Werner Buthe
  7560.   LOCAL d0%                     !R
  7561. ckgabewert aus C:-Aufruf 
  7562.   LOCAL lines_count%            !Aufaddierte d0%-Werte
  7563.   LOCAL buff_max%
  7564.   LOCAL block%
  7565.   ' "B
  7566. se" lines_maxlen% plus das LF reinpatchen
  7567.   '  {
  7568.  +40}=-lines_maxlen%-1
  7569.   ' Pr
  7570. fpuffer einrichten
  7571.   ' ---------------------
  7572.   buff_max%=FRE(0)-&HFFFF       !'n bi
  7573. chen (64kB) lassen wir frei :-)
  7574.   IF buff_max%<=0               !Kein Speicher mehr frei
  7575.     RETURN -1
  7576.   ENDIF
  7577.   ADD buff_max%,ODD(buff_max%)  !Immer GRADZAHLIGE Speicherbl
  7578. cke nutzen!!!
  7579.   DIM buff|(PRED(buff_max%))
  7580.   ' @
  7581. %mouse(busybee&,0)
  7582.   IF file_len%<buff_max%
  7583.     BLOAD file$,V:buff|(0)
  7584.     lines_count%=C:
  7585.  (L:V:buff|(0),L:file_len%)
  7586.   ELSE
  7587.     OPEN "i",#99,file$
  7588.     DO
  7589.       block%=MIN(buff_max%,file_len%)
  7590.       EXIT IF block%<=0
  7591.       BGET #99,V:buff|(0),block%
  7592.       d0%=C:
  7593.  (L:V:buff|(0),L:block%)
  7594.       ADD lines_count%,d0%
  7595.       SUB file_len%,block%
  7596.       IF d0%<0
  7597.         lines_count%=-1
  7598.       ENDIF
  7599.       EXIT IF d0%<0
  7600.     LOOP
  7601.     CLOSE #99
  7602.   ENDIF
  7603.   ERASE buff|()
  7604.   ' @
  7605. %mouse(arrow&,0)
  7606.   RETURN 
  7607. #MAX(PRED(lines_count%),-1)
  7608. ENDFUNC
  7609. lXBRA                                                          GFA-Util
  7610. Autor: Peter Harder @ NF
  7611. Ich habe mir schon die XBRA-Function gebastelt; war einfacher, als
  7612. ich dachte. LETEMFLY wird bei mir ausgeh
  7613. ngt, wenn ich f
  7614. r ein
  7615. Programm eine Extension angemeldet habe (z.B. LZH f
  7616. r LZH.TTP) und
  7617. dann eine entsprechende LZH-Datei starte. Bei einem nochmaligen Start
  7618. von LETEMFLY h
  7619. ngt es sich nicht wieder ein, weil die Kennung noch im
  7620. Cookie ist. Kann man die Zeiger sebst wieder zur
  7621. ckbiegen?
  7622. IF @xbra(&H88,"LTMF")>0
  7623.   PRINT "LETEMFLY h
  7624. ngt noch in TRAP #2"
  7625.   PRINT "LETEMFLY wurde aus TRAP #2 ausgeh
  7626. ENDIF
  7627. FUNCTION xbra(adr%,code$)
  7628.   adr%=LPEEK(adr%)
  7629.     IF MKL$({adr%-12})<>"XBRA"
  7630.       adr%=0
  7631.     ENDIF
  7632.     EXIT IF adr%=0
  7633.     '
  7634.     '  PRINT MKL$({adr%-8})  ! Was h
  7635. ngt da eigentlich alles drin?
  7636.     EXIT IF MKL$({adr%-8})=code$
  7637.     adr%={adr%-4}
  7638.     '
  7639.   LOOP
  7640.   RETURN adr%
  7641. ENDFUNC
  7642. lMagiC-Unfreeze                                                GFA-Util
  7643. Autor: 
  7644. *Ulf Dunkel @ CLP
  7645. nur mal rasch so eingetippt, ohne Handbuch, ohne Editor, ohne Gew
  7646. auf Lauff
  7647. higkeit, aber vielleicht hilft's weiter...
  7648. PROCEDURE const_magic
  7649.   ' ...
  7650.   LET sm_m_special&=101   !+SYM
  7651.   ' Screnmgr function codes
  7652.   ' -----------------------
  7653.   LET smc_freeze&=3       !+SYM
  7654.   LET smc_unfreeze&=4     !+SYM
  7655.   LET screnmgr&=1         !+SYM
  7656.   ' ...
  7657. RETURN
  7658. PROCEDURE gem_init
  7659.   ' ...
  7660.   ap_id&=APPL_INIT()
  7661.   ' ...
  7662. RETURN
  7663. FUNCTION unfreeze
  7664.   $F%
  7665.   ' INTENT: Versuch, Programme unter MagiC "auszufrieren"
  7666.   ' RETURN: FALSE, wenn irgendein Fehler, sonst TRUE
  7667.   ERASE buf&()            !Sicher ist sicher ...
  7668.   DIM buf&(7)
  7669.   buf&(0)=sm_m_special&
  7670.   buf&(1)=ap_id&
  7671.   buf&(2)=0
  7672.   buf&(3)=0
  7673.   buf&(4)=CVI("MA")
  7674.   buf&(5)=CVI("GX")
  7675.   buf&(6)=smc_unfreeze&
  7676.   buf&(7)=child_id
  7677.   RETURN APPL_WRITE(screnmgr&,16,V:buf&(0))
  7678. ENDFUNC
  7679. lminfrei                                                       GFA-Util
  7680. Autor 
  7681. ,Reiner Rosin @ WI2
  7682. Ich hab' mir mal eine Routine gebastelt, die innerhalb der
  7683. Hauptschleife und an speicherintensiven Stellen aufgerufen wurde.
  7684. Diese Routine ermittelt den minimal freien Speicher 
  7685. ber einen
  7686. ngeren Zeitraum und liefert so m.E. aussagekr
  7687. ftiger Werte. Bei 10
  7688. Betatestern installiert erh
  7689. lt man einen recht zuverl
  7690. ssige
  7691. Informationen 
  7692. ber den ben
  7693. tigten Speicher:
  7694. PROC minfrei
  7695. LOCAL z
  7696. IF minfrei=0
  7697.   IF EXIST("C:\MINFREI.DAT")
  7698.     OPEN #13,"I","MINFREI.DAT"
  7699.     INPUT #13,minfrei
  7700.     CLOSE #13
  7701.   ELSE
  7702.     minfrei=99999999
  7703.   ENDIF
  7704. ENDIF
  7705. z=FRE(0)
  7706. IF z<minfrei
  7707.   minfrei=z
  7708.   OPEN #13,"O","C:\MINFREI.DAT"
  7709.   PRINT #13,minfrei
  7710.   CLOSE #13
  7711. ENDIF
  7712. RETURN
  7713. lDMA-Sound                                                     GFA-Util
  7714. Autor: Joachim Hurst @ B
  7715. Jau, hier ein bischen was Code mit den hoffentlich wichtigsten
  7716. Ausschnitten, ist von '92, also nicht schreien/flamen. Der
  7717. interessanteste Teil d
  7718. rfte in den Procs stecken, der Rest ist blo
  7719. zum Verst
  7720. ndnis.
  7721. DIM sample|(100*1024)                         ! Platz f
  7722. r Sample machen
  7723. start%=0              ! 1 Byte des Samples
  7724. fin%=0                ! letztes Byte des Samples
  7725. freq%=1               ! Geschwindigkeitszeiger: 1-4=6.25,12.5,...
  7726. anz%=1                ! Wiederholen: 1 mal oder endlos
  7727. mix%=1                ! Zeiger auf MIX: -12dB, Mix, nix
  7728. bass%=6               ! Default-Wert: Bass
  7729. trbl%=10              !               Treble
  7730. volli%=20             !               Volumen links
  7731. volre%=20             !               Volumen rechts
  7732. master%=40            !               Volumen Master
  7733. sample!=FALSE         ! Flag, ob Sample geladen wurde
  7734. OPEN "I",1,datei$
  7735. fin%=LOF(#1)                      ! L
  7736. nge des Samples feststellen
  7737. CLOSE #1
  7738. IF fin%<100000                    ! passt's 
  7739. berhaupt in Speicher
  7740.   adr%=VARPTR(sample|(0))         ! wenn ja, Startadresse merken
  7741.   BLOAD pfad$+sam$,adr%           ! laden
  7742.   sample!=TRUE                    ! und Flag setzen
  7743. ELSE                              ! ansonsten:
  7744.   ALERT 1," |Sample zu gro
  7745. , sorry!| ",1,"Abbruch",dummy%
  7746.   sample!=FALSE                   ! Fehler merken
  7747.   fin%=0                          ! keine L
  7748. nge markieren
  7749. ENDIF
  7750. PROCEDURE nosound
  7751.   DMACONTROL 0
  7752. RETURN
  7753. PROCEDURE mwi_ansteuern
  7754.   mask%=&H7FF
  7755.   x$="&X10"             ! ansteuerungsinitialisierung
  7756.   a$="011"              ! Ansteuern: Master Volumen
  7757.   b$=BIN$(master%,8)
  7758.   a$=a$+RIGHT$(b$,6)    ! nur die rechten 6 bits
  7759.   MW_OUT mask%,VAL(x$+a$)
  7760.   a$="101"              ! Ansteuern: LCV
  7761.   b$=BIN$(volli%,8)
  7762.   a$=a$+RIGHT$(b$,6)    ! nur die rechten 5 bits
  7763.   MW_OUT mask%,VAL(x$+a$)
  7764.   a$="100"              ! Ansteuern: RCV
  7765.   b$=BIN$(volre%,8)
  7766.   a$=a$+RIGHT$(b$,6)    ! nur die rechten 5 bits
  7767.   MW_OUT mask%,VAL(x$+a$)
  7768.   a$="010"              ! Ansteuern: TREBLE
  7769.   b$=BIN$(trbl%,8)
  7770.   a$=a$+RIGHT$(b$,4)    ! nur die rechten 4 bits
  7771.   MW_OUT mask%,VAL(x$+a$)
  7772.   a$="001"              ! Ansteuern: BASS
  7773.   b$=BIN$(bass%,8)
  7774.   a$=a$+RIGHT$(b$,4)    ! nur die rechten 4 bits
  7775.   MW_OUT mask%,VAL(x$+a$)
  7776.   a$="000"              ! Ansteuern: Mixer
  7777.   b$=BIN$(mix%-1,8)
  7778.   a$=a$+RIGHT$(b$,2)    ! nur die rechten 2 bits
  7779.   MW_OUT mask%,VAL(x$+a$)
  7780. RETURN
  7781. PROCEDURE play_dma
  7782.   LOCAL wdh%,tempo%
  7783.   wdh%=anz%              ! Wiederholungen feststellen,
  7784.   IF wdh%=2              ! etwa endlos ?
  7785.     INC wdh%             ! dann merken
  7786.   ENDIF
  7787.   tempo%=freq%-1
  7788.   IF play!=TRUE
  7789.     DMASOUND V:sample|(start%),V:sample|(fin%),tempo%,wdh%
  7790.   ENDIF
  7791. RETURN
  7792. lDruck-Routine                                                 GFA-Util
  7793. Autor: 
  7794. ,Reiner Rosin @ WI2
  7795. PROCEDURE hp_print_mit_rand(adresse,breite,hoehe,aufloesung,randx,randy)
  7796.   ' Druckt eine Bitmap auf dem HP-Desk/Laserjet
  7797.   ' Parameter:
  7798.   '                  adresse   : 
  7799. 'Adresse der zu druckenden Bitmap
  7800.   '                  breite    : Bitmapbreite in Pixeln
  7801.   '                  hoehe     : Bitmaph
  7802. he in Pixeln
  7803.   '                  aufloesung: 2,150 = 150 DPI
  7804.   '                              3,4,75 = 75 DPI
  7805.   '                              5,100 = 100 DPI
  7806.   '                              ansonsten: 300 DPI
  7807.   '                  randx     : linker Rand in Pixeln
  7808.   '                  randy     : oberer Rand in Pixeln
  7809.   ' V1.0 vom 7.8.91
  7810.   LOCAL dx,a$,druckbreite
  7811.   randx=randx DIV 8
  7812.   dx=(breite+7) DIV 8
  7813.   SELECT aufloesung
  7814.   CASE 75,3,4
  7815.     aufloesung=75
  7816.   CASE 100,5
  7817.     aufloesung=100
  7818.   CASE 150,2
  7819.     aufloesung=150
  7820.   DEFAULT
  7821.     aufloesung=300
  7822.   ENDSELECT
  7823.   OPEN #33,"O","PRN:"
  7824. 2' #UMBRUCH ANFANG!
  7825.   PRINT #33,CHR$(27);"*t";STR$(aufloesung);"R";CHR$(27);
  7826.   "*p0X";CHR$(27);"&a0V";CHR$(27);"*r0A";
  7827. 0' #UMBRUCH ENDE!
  7828.   a$=CHR$(27)+"*b1W"+CHR$(0)
  7829.   FOR y=0 TO randy
  7830.     PRINT #33,a$;
  7831.   NEXT y
  7832.   druckbreite=MIN(dx+randx,aufloesung)
  7833.   a$=STRING$(druckbreite,CHR$(0))
  7834.   FOR y=0 TO hoehe-1
  7835.     BMOVE adresse,VARPTR(a$)+randx,druckbreite-randx
  7836.     ADD adresse,dx
  7837.     PRINT #33,CHR$(27);"*b";STR$(druckbreite);"W";a$;
  7838.   NEXT y
  7839.   '  CLOSE #33
  7840. RETURN
  7841. lUFSL-Init                                                     GFA-Util
  7842. Autor: Frank R
  7843. ger @ OS2
  7844. Folgendes irgendwo am Anfang bei der Programminitialisierung
  7845. aufrufen! Die Speicheranforderung kann nat
  7846. rlich mit anderen
  7847. M[x]alloc's zusammengefa
  7848. t werden!
  7849. PROCEDURE ufsl_init
  7850. amount%=112                             !Puffer f
  7851. r UFSL
  7852. ufslbuf%=@my_malloc(amount%,mx_prefalt&,mx_prot_readable&)
  7853. IF ufslbuf%<=0
  7854.   ' Fehlermeldung
  7855. ENDIF
  7856. fretid%=ufslbuf%                        !Je ein Word f
  7857. r die
  7858. fretsize%=ADD(fretid%,2)                !UFSL-Returns (4)
  7859. ufsl_titel%=ADD(fretsize%,2)
  7860. CHAR{ufsl_titel%}="SaugUtil: Zeichensatz w
  7861. hlen"    !UFSL-Titel (36)
  7862. ufsl_exmpl%=ADD(ufsl_titel%,36)           !Beipielstring f
  7863. r UFSL (72)
  7864. CHAR{ufsl_exmpl%}="Test Der schnelle braune Fuchs springt 
  7865. ber den faulen Hund 1234567890"
  7866. RETURN
  7867. FUNCTION my_malloc(amount%,mode&,prot&)
  7868.   $F%
  7869.   IF gemdos_ge_0_19!
  7870.     RETURN 
  7871.  (mxalloc&,L:amount%,mode& OR -(mint! OR magx2!)*prot&)
  7872.   ENDIF
  7873.   RETURN MALLOC(amount%)
  7874. ENDFUNC
  7875. PROCEDURE font_selector
  7876.   LOCAL rfontsize&,rfontnr&
  7877.   LOCAL ufsl_cookie%,font_selinit%,font_selinput%,font_ok!,font_selinput&
  7878.   LOCAL msg$
  7879.   font_ok!=-1
  7880.   rfontnr&=fontnr&
  7881.   rfontsize&=opt_fontsize&
  7882.   IF @
  7883. +get_cookie("UFSL",ufsl_cookie%)
  7884.     font_selinit%={ADD(ufsl_cookie%,8)}
  7885.     font_selinput%={ADD(ufsl_cookie%,12)}
  7886.     windup(beg_update&)
  7887.     windup(beg_mctrl&)
  7888.     ~C:font_selinit%()
  7889.     '
  7890.     {ADD(ufsl_cookie%,24)}=ufsl_exmpl%  !Beispieltext
  7891.     '
  7892.     ' Nur monospaced Fonts zulassen (ftype=1):
  7893.     '
  7894. 2' #UMBRUCH ANFANG!
  7895.     font_selinput&=C:font_selinput%(vdi_handle&,anzfonts&,
  7896.     1,L:ufsl_titel%,L:fretid%,L:fretsize%)
  7897. 0' #UMBRUCH ENDE!
  7898.     '
  7899.     windup(end_update&)
  7900.     windup(end_mctrl&)
  7901.     SELECT font_selinput&
  7902.     CASE 1
  7903.       opt_fontindex&=INT{fretid%}
  7904.       FOR fontnr&=0 TO PRED(anzfonts&)
  7905.         EXIT IF fonts&(fontnr&)=opt_fontindex&
  7906.       NEXT fontnr&
  7907.       opt_fontsize&=INT{fretsize%}
  7908.     DEFAULT
  7909.       CLR font_ok!
  7910.       SELECT font_selinput&
  7911.       CASE -1
  7912.         msg$="*Out of memory!*"
  7913.       CASE -2
  7914.         msg$="*Unzul
  7915. ssiger Mehrfachaufruf!*"
  7916.       CASE -3
  7917.         msg$="*Fontgr
  7918. e konnte nicht identifiziert*|*werden!*"
  7919.       CASE -4
  7920.         msg$="*Anzahl Fonts mu
  7921. er Null sein!*"
  7922.       ENDSELECT
  7923.       IF font_selinput&
  7924.         
  7925. 2' #UMBRUCH ANFANG!
  7926.         ~@my_alert(note&,"Fehler beim UFSL-
  7927.         Aufruf!|Fehlercode:"+STR$(font_selinput&)+"|entspricht
  7928.         Fehlermeldung:|"+msg$,1,"Abbruch")
  7929.         
  7930. 0' #UMBRUCH ENDE!
  7931.       ENDIF
  7932.     ENDSELECT
  7933.   ELSE
  7934.     'eigener Selektor oder Fehlermeldung ...
  7935.   ENDIF
  7936.   IF font_ok! AND (fontnr&<>rfontnr& OR opt_fontsize&<>rfontsize&)
  7937.     font_berechnen
  7938.     fenster_anpassen
  7939.   ENDIF
  7940. RETURN
  7941. lFalcon-Sound                                                  GFA-Util
  7942. Autor: 
  7943. ,Reiner Rosin @ WI2
  7944. DEFINT "a-z"
  7945. ' Falcon-Software: Stereo-Signal per DMA in den Speicher,
  7946. '                  und gleichzeitig per DMA wieder heraus
  7947. '                  10.12.93
  7948. INLINE z,20548
  7949. %XBIOS(3)
  7950. PRINT 
  7951. %XBIOS(130,2,16*8)            ! verst
  7952. rkung links
  7953. PRINT 
  7954. %XBIOS(130,3,16*8)            ! verst
  7955. rkung rechts
  7956. PRINT 
  7957. %XBIOS(130,4,1)               ! ???
  7958. PRINT 
  7959. %XBIOS(130,5,0)               ! Quelle f
  7960. r ADC
  7961. PRINT 
  7962. %XBIOS(130,6,2)               ! Kompatibilit
  7963. t (entf
  7964. PRINT 
  7965. %XBIOS(131,1,L:z,L:z+16084)   ! Aufnahmepuffer
  7966. PRINT 
  7967. %XBIOS(132,1)                 ! 16 Bit sterero
  7968. PRINT 
  7969. %XBIOS(133,0,0)               ! je 1 Kanal Play/Record
  7970. PRINT 
  7971. %XBIOS(135,0,0)               ! keine Interrupts
  7972. PRINT 
  7973. %XBIOS(136,12)                ! Record enable
  7974. PRINT 
  7975. %XBIOS(139,3,1,0,11,1)
  7976. PRINT 
  7977. %XBIOS(130,4,2)
  7978. PRINT 
  7979. %XBIOS(130,6,3)
  7980. PRINT 
  7981. %XBIOS(131,0,L:z,L:z+16084)
  7982. PRINT 
  7983. %XBIOS(132,1)
  7984. PRINT 
  7985. %XBIOS(133,0,0)
  7986. PRINT 
  7987. %XBIOS(134,0)
  7988. PRINT 
  7989. %XBIOS(135,0,0)
  7990. PRINT 
  7991. %XBIOS(136,15)
  7992. PRINT 
  7993. %XBIOS(139,0,8,0,0,1)
  7994. ALERT 1,"OK",1,"OK",ok
  7995. GOSUB off
  7996. PROCEDURE off
  7997. %XBIOS(136,0)
  7998. RETURN
  7999. llprint$()                                                     GFA-Util
  8000. Autor: Frank R
  8001. ger @ OS2
  8002. crlf!   -> TRUE -> Zeilenende anh
  8003. ngen.
  8004. serial! -> TRUE -> Ausgabe auf stdaux, sonst auf stdprn.
  8005. ckgabewert: Anzahl der gedruckten Zeichen oder ein negativer
  8006.               Fehlercode.
  8007. ffnen ist nicht n
  8008. tig, da die Standardkan
  8009. le immer offen sind!
  8010. FUNCTION lprint(text$,crlf!,serial!)
  8011.   $F%
  8012.   IF crlf!
  8013.     text$=text$+CHR$(13)+CHR$(10)
  8014.   ENDIF
  8015.   RETURN 
  8016.  (64,3+serial!,L:LEN(text$),L:V:text$)
  8017. ENDFUNC
  8018. ltest_printer_online() (nach R
  8019. ger)                            GFA-Util
  8020. Autor: Frank R
  8021. ger @ OS2
  8022. Ob der Drucker 
  8023. berhaupt empfangsbereit ist, kann man mit dieser
  8024. Funktion testen:
  8025. FUNCTION test_printer_online(serial!)
  8026.   $F%
  8027.   LOCAL drucker|
  8028.   REPEAT
  8029.     IF 
  8030.  (17-2*serial!))=0
  8031.       
  8032. 2' #UMBRUCH ANFANG!
  8033.       drucker|=FORM_ALERT(2,"[1][ | Bitte Drucker auf| 'ONLINE'|
  8034.       schalten!][Abbruch|Drucken]")
  8035.       
  8036. 0' #UMBRUCH ENDE!
  8037.     ENDIF
  8038.   UNTIL 
  8039.  (17-2*serial!)<>0 OR drucker|<2
  8040.   RETURN drucker|<>1
  8041. ENDFUNC
  8042. ckgabewert: TRUE -> Drucken m
  8043. glich.
  8044. ltest_printer_online() (nach Duchalski)                        GFA-Util
  8045. Autor: 
  8046. 0Gregor Duchalski @ DO
  8047. ' Testet, ob der Drucker eingeschaltet ist (TRUE)...
  8048. DEFFN online=
  8049. $BIOS(8,0)                   ! Printer online?
  8050. lMODEM 2                                                       GFA-Util
  8051. Autor: 
  8052. -David Reitter @ WI2
  8053. Ansprechen von CarrierDetect und DataTerminalReady bei allen aktuell
  8054. bekannten seriellen Schnittstellen von Atari-Computern
  8055. -David Reitter, 30.04.1994)
  8056. Die Routinen ben
  8057. tigen t_sst& als Variable f
  8058. r die zu benutzende
  8059. Schnittstelle. Das Ermitteln und Setzen sollte 
  8060. ber die
  8061. Betriebssystemfunktionen 
  8062. 'Bconmap() (Vorhandensein abfragen!) und
  8063. &Rsconf() geschehen, bei Vorhandensein sollten der FSER-Cookie und der
  8064. RSFV-Cookie unterst
  8065. tzt werden. Wenn sie nicht vorhanden sein, m
  8066. dem Benutzer Standardwerte f
  8067. r die Schnittstellengeschwindigkeiten
  8068. vorgegeben werden. H
  8069. here Geschwindigkeiten als 19200 Baud sind nicht
  8070. auf Modem1, und nur bei Verwendung von FastSer von 
  8071. *Franz Sirl oder
  8072. 'HSMODEM von 
  8073. /Harun Scheutzow m
  8074. glich. Alternativ k
  8075. nnen auch eigene
  8076. (schnelle) Schnittstellenroutinen installiert werden, was sich aber
  8077. in der Regel nicht lohnt.
  8078. Das Senden und Empfangen l
  8079. uft weiterhin 
  8080. ber Kanal 1 (oder AUX:),
  8081. durch 
  8082. 'Bconmap() werden die Schnittstellendaten entsprechend
  8083. umgeleitet.
  8084. DataTerminalReady (DTR) steuert haupts
  8085. chlich bei den meisten Modems
  8086. (und Einstellungen) die Aufrechterhaltung der Leitung. Es ist
  8087. meistens zum Auflegen n
  8088. tzlich. CarrierDetect ist bei der
  8089. Programmierung i.d.R. immer ben
  8090. tigt, um auf vorzeitige
  8091. Unterbrechungen von Verbindungen korrekt reagieren zu k
  8092. nnen.
  8093. In GFA-Basic kann man auf diese Signale wie folgt (sauber) zugreifen:
  8094. PROCEDURE dtr_aus
  8095.   LOCAL a%,sr%,s%
  8096.   INLINE stop_itr%,42
  8097.   INLINE start_itr%,40
  8098.   SELECT t_sst&
  8099.   CASE 0
  8100.     ~
  8101. %XBIOS(30,16)
  8102.   CASE 1
  8103.     s%=
  8104.  (32,L:0)   ! Schaltet in den Supervisormodus.
  8105.     sr%=C:stop_itr%()
  8106.     ~
  8107.  (32,L:s%)   ! Schaltet in den Usermodus
  8108.     a%=BYTE{
  8109. %XBIOS(14,0)+&H1D}
  8110.     BYTE{
  8111. %XBIOS(14,0)+&H1D}=BCLR(a%,7)
  8112.     SPOKE &HFFFF8C85,&H5                          ! Chip-Register 5 selektieren
  8113.     SPOKE &HFFFF8C85,BCLR(a%,7)                   ! Bit 7 ist entscheident
  8114.     s%=
  8115.  (32,L:0)   ! Schaltet in den Supervisormodus.
  8116.     ~C:start_itr%(sr%)
  8117.     ~
  8118.  (32,L:s%)   ! Schaltet in den Usermodus
  8119.   CASE 2
  8120.     ~
  8121. %XBIOS(30,16)
  8122.   CASE 3
  8123.     s%=
  8124.  (32,L:0)   ! Schaltet in den Supervisormodus.
  8125.     sr%=C:stop_itr%()
  8126.     ~
  8127.  (32,L:s%)   ! Schaltet in den Usermodus
  8128.     a%=BYTE{
  8129. %XBIOS(14,0)+&H1D}
  8130.     BYTE{
  8131. %XBIOS(14,0)+&H1D}=BCLR(a%,7)
  8132.     SPOKE &HFFFF8C81,&H5                          ! Chip-Register 5 selektieren
  8133.     SPOKE &HFFFF8C81,&H68                         ! Bit 7 ist entscheident
  8134.     s%=
  8135.  (32,L:0)   ! Schaltet in den Supervisormodus.
  8136.     ~C:start_itr%(sr%)
  8137.     ~
  8138.  (32,L:s%)   ! Schaltet in den Usermodus
  8139.   ENDSELECT
  8140. RETURN
  8141. PROCEDURE dtr_an
  8142.   LOCAL a%,sr%,s%
  8143.   INLINE stop_itr%,42
  8144.   INLINE start_itr%,40
  8145.   SELECT t_sst&
  8146.   CASE 0
  8147.     ~
  8148. %XBIOS(29,239)
  8149.   CASE 1
  8150.     s%=
  8151.  (32,L:0)   ! Schaltet in den Supervisormodus.
  8152.     sr%=C:stop_itr%()
  8153.     ~
  8154.  (32,L:s%)   ! Schaltet in den Usermodus
  8155.     a%=BYTE{
  8156. %XBIOS(14,0)+&H1D}
  8157.     BYTE{
  8158. %XBIOS(14,0)+&H1D}=BSET(a%,7)
  8159.     SPOKE &HFFFF8C85,&H5                          ! Chip-Register 5 selektieren
  8160.     SPOKE &HFFFF8C85,BSET(a%,7)                   ! Bit 7 ist entscheident
  8161.     s%=
  8162.  (32,L:0)   ! Schaltet in den Supervisormodus.
  8163.     ~C:start_itr%(sr%)
  8164.     ~
  8165.  (32,L:s%)   ! Schaltet in den Usermodus
  8166.   CASE 2
  8167.     ~
  8168. %XBIOS(29,239)
  8169.   CASE 3
  8170.     s%=
  8171.  (32,L:0)   ! Schaltet in den Supervisormodus.
  8172.     sr%=C:stop_itr%()
  8173.     ~
  8174.  (32,L:s%)   ! Schaltet in den Usermodus
  8175.     a%=BYTE{
  8176. %XBIOS(14,0)+&H1D}
  8177.     BYTE{
  8178. %XBIOS(14,0)+&H1D}=BSET(a%,7)
  8179.     SPOKE &HFFFF8C81,&H5                          ! Chip-Register 5 selektieren
  8180.     SPOKE &HFFFF8C81,BSET(a%,7)                   ! Bit 7 ist entscheident
  8181.     s%=
  8182.  (32,L:0)   ! Schaltet in den Supervisormodus.
  8183.     ~C:start_itr%(sr%)
  8184.     ~
  8185.  (32,L:s%)   ! Schaltet in den Usermodus
  8186.   ENDSELECT
  8187. RETURN
  8188. FUNCTION cdt
  8189.   LOCAL a%,sr%,s%,t!
  8190.   INLINE stop_itr%,42
  8191.   INLINE start_itr%,40
  8192.   SELECT t_sst&
  8193.   CASE 0
  8194.     RETURN NOT BTST(PEEK(&HFFFA01),1)
  8195.   CASE 1
  8196.     s%=
  8197.  (32,L:0)   ! Schaltet in den Supervisormodus.
  8198.     sr%=C:stop_itr%()
  8199.     ~
  8200.  (32,L:s%)   ! Schaltet in den Usermodus
  8201.     SPOKE &HFFFF8C85,0                      ! Chip-Register 0 selektieren
  8202.     t!=BTST(PEEK(&HFFFF8C85),3)             ! Bit 3 sagt alles...
  8203.     s%=
  8204.  (32,L:0)   ! Schaltet in den Supervisormodus.
  8205.     ~C:start_itr%(sr%)
  8206.     ~
  8207.  (32,L:s%)   ! Schaltet in den Usermodus
  8208.     RETURN t!
  8209.   CASE 2
  8210.     RETURN NOT BTST(PEEK(&HFFFA01),1)
  8211.   CASE 3
  8212.     s%=
  8213.  (32,L:0)   ! Schaltet in den Supervisormodus.
  8214.     sr%=C:stop_itr%()
  8215.     ~
  8216.  (32,L:s%)   ! Schaltet in den Usermodus
  8217.     SPOKE &HFFFF8C81,0                      ! Chip-Register 0 selektieren
  8218.     t!=BTST(PEEK(&HFFFF8C81),3)             ! Bit 3 sagt alles...
  8219.     s%=
  8220.  (32,L:0)   ! Schaltet in den Supervisormodus.
  8221.     ~C:start_itr%(sr%)
  8222.     ~
  8223.  (32,L:s%)   ! Schaltet in den Usermodus
  8224.     RETURN t!
  8225.   ENDSELECT
  8226. ENDFUNC
  8227.   stop_itr% und start_itr% - zum Speichersparen am Besten
  8228. in einer Init-Prozedur unterbringen enthalten:
  8229. begin 777 STOP_ITR.INL
  8230. J8!H    *        *                 <  $#! 'P' # !3G4
  8231. begin 777 START_ITR.INL
  8232. H8!H    (        *                 <  #(O  1&P4YU       \
  8233. (Bitte per UUX dekodieren.)
  8234. Als Source:
  8235. ; START_ITR
  8236. ; Nimmt 1 Word vom Stack und erlaubt damit Interrupts wieder
  8237. move.w 4(SP),D1
  8238. move.w d1,sr
  8239. ; STOP_ITR
  8240. ; Stoppt Interrupts und liefert in D0 den alten Wert (merken !)
  8241. ; zur
  8242. ; Darf nur im Supervisormodus aufgerufen werden !
  8243. move.w sr,d1
  8244.  ori.w #$700,sr
  8245. move.w d1,d0
  8246. Bei R
  8247. ckfragen: 
  8248. ffentliche Gruppen des MausNetz (DF
  8249. ) oder
  8250. -David Reitter Albinistr. 10 55116 Mainz (frank. R
  8251. ckumschlag
  8252. beilegen)
  8253. oder per DF
  8254. : david_reitter@wi2.maus.de
  8255. lCreate Inline Assembler File                                  GFA-Util
  8256. Autor: Michael Urrey @ ??, Dieter Wiesemann @ ??
  8257. ALERT 0,"Create Inline Assembler File  | f
  8258. r GFA Basic 3.0x | 
  8259.  by Dieter Wiesemann und | Michael Urrey",1,"SUPER|Ende",dummy%
  8260. IF dummy%=2
  8261.   END
  8262. ENDIF
  8263.     ' assemblerprogramm laden und als inline file saven
  8264.     '
  8265.     FILESELECT "\*.*","",file$
  8266.     ext$=UPPER$(RIGHT$(file$,3))
  8267.     EXIT IF ext$="PRG" OR ext$="TOS"
  8268.     ALERT 1," Ich mag nur PRG | oder TOS-Files ",1," OK ",but%
  8269.   LOOP
  8270.   ' den unnoetigen programm header wegwerfen
  8271.   OPEN "I",#1,file$
  8272.   inline$=RIGHT$(INPUT$(LOF(#1),#1),LOF(#1)-28)
  8273.   laenge%=LOF(#1)-28
  8274.   CLOSE #1
  8275.   inl_file$=LEFT$(file$,LEN(file$)-3)+"INL"
  8276.   BSAVE inl_file$,VARPTR(inline$),LEN(inline$)
  8277.   ' list file erzeugen zum einbinden ins Programm
  8278.   count%=LEN(file$)
  8279.     EXIT IF MID$(file$,count%,1)="\"
  8280.     DEC count%
  8281.   LOOP
  8282.   ' den Filenamen suchen und den Pfad fuers LST file erzeugen
  8283.   test$=RIGHT$(file$,LEN(file$)-count%)
  8284.   lstfile$=LEFT$(test$,LEN(test$)-3)+"LST"
  8285.   lstfile$=LEFT$(file$,LEN(file$)-LEN(lstfile$))+lstfile$
  8286.   nam$=LEFT$(test$,LEN(test$)-4)
  8287.   PRINT file$               ! auf der screen soll auch was zu sehen sein
  8288.   PRINT lstfile$
  8289.   PRINT nam$
  8290.   ' und nun das listing zum mergen
  8291.   dummy$=CHR$(13)+CHR$(10)
  8292.   laenge$=STR$(laenge%)
  8293.   lst0$="'Assembler Routine "+nam$+" einbinden"+dummy$
  8294.   lst1$=nam$+"$=SPACE$("+laenge$+")"+dummy$
  8295.   lst2$=nam$+"%=VARPTR("+nam$+"$)"+dummy$
  8296.   lst3$="INLINE "+nam$+"%,"+laenge$+dummy$
  8297.   lst$=lst0$+lst1$+lst2$+lst3$
  8298.   PRINT lst$
  8299.   BSAVE lstfile$,VARPTR(lst$),LEN(lst$)
  8300.   ALERT 2," | |weitermachen ",1," klaa| n
  8301. ",dummy%
  8302.   EXIT IF dummy%=2
  8303.   CLS
  8304. lAuslesen des $m-Wertes eines Compilates                       GFA-Util
  8305. Autor: J
  8306. rgen Meyer @ HH2
  8307. Hier mal ein (uralter) Source, den ich mal zum Auslesen des $m-Wertes
  8308. aus Compilaten geschrieben habe. Klappt mit allen Compilaten ab V3.02
  8309. bis zur V3.6 TT.
  8310. Wer Lust hat, kann ja mal ein nettes 
  8311. #GEM-Programm zum Patchen von $m-
  8312. Werten schreiben :-)
  8313. lAnmerkung:
  8314. d Ich (Peter) habe tats
  8315. chlich ein kleines, auf dieser
  8316. Routine basierendes Progr
  8317. mmchen zum Patchen des $m-Wertes
  8318. geschrieben (lat
  8319. rnich voll in 
  8320. #GEM eingebunden und etwas schneller ;-
  8321. ). Falls Ihr Interesse habt, so lege ich es mal in eine Maus.
  8322. ' Erfrage $M-Wert eines V3.50 Compilates      (wr) 27.02.1991
  8323. $M65536
  8324. PRINT AT(2,2);"Compilat w
  8325. hlen !"
  8326. FILESELECT CHR$(
  8327.  (&H19)+65)+":"+DIR$(0)+"\*.*","",file$
  8328. IF EXIST(file$)=FALSE
  8329.   CLS
  8330.   END
  8331. ENDIF
  8332. CLR mem%,found!
  8333. OPEN "I",#1,file$
  8334. le%=LOF(#1)
  8335. IF MALLOC(-1)<le%
  8336.   ALERT 1,"Nicht genug Speicher !",1,"ABBRUCH",i%
  8337.   mem%=MALLOC(le%)
  8338.   BGET #1,mem%,le%
  8339. ENDIF
  8340. CLOSE #1
  8341. IF mem%<>0
  8342.   FOR i%=mem% TO ADD(mem%,SUB(le%,2)) STEP 2
  8343.     IF {i%}=&H40005C8F AND {ADD(i%,4)}=&H72FE0281
  8344.       found!=TRUE
  8345.     ENDIF
  8346.     EXIT IF found!=TRUE
  8347.   NEXT i%
  8348.   m%={ADD(i%,8)}
  8349.   IF found!=TRUE AND m%<>-1
  8350.     ALERT 1,"$M - Wert des Compilats :| |"+STR$(m%)+" ($"+HEX$(m%,8)+")",1," OK",i%
  8351.   ELSE
  8352.     ALERT 1,"Das angew
  8353. hlte Compilat|"+file$+"|enth
  8354. lt keine $M-Anweisung!",1,"ABBRUCH",i%
  8355.   ENDIF
  8356.   ~MFREE(mem%)
  8357. ENDIF
  8358. lMultitask-APP???                                              GFA-Util
  8359. Autor: Frank R
  8360. ger @ OS2
  8361. eFrage:
  8362. d Wie erkenne ich, ob mein Programm unter einen MagiC/MultiTOS
  8363.     gestartet wurde? Unter MagiC ist noch wichtig, ob es als Single-
  8364.     Task gestartet wurde?
  8365. ap_count&=INT{ADD({ADD(GB,4)},2)}       !Anzahl der m
  8366. glichen Prozesse
  8367. ap_version&=INT{{ADD(GB,4)}}            !
  8368.  -Version
  8369. mint!=@
  8370. +get_cookie("MiNT",mint_version%) !MiNT?
  8371. mtos!=ap_count&<>1 AND ap_version&>=&H400 AND mint!
  8372. magx!=@
  8373. +get_cookie("MagX",magx_cookie%)
  8374. magx_version%=INT{{magx_cookie%+8}+48}
  8375. ' z.B.
  8376. ' magx2!=magx_version%>=&H200
  8377. magx_single!=magx! AND ap_count&=1
  8378. lSPLines                                                       GFA-Util
  8379. Autor: Ingo Dehne @ W
  8380. ' SPLINE.LST
  8381. PROCEDURE init
  8382.   anz_max&=100
  8383.   schritt_max&=100
  8384.   DIM a(anz_max&),b(anz_max&),c(anz_max&),d(anz_max&)
  8385.   DIM x_stuetz(anz_max&),y_stuetz(anz_max&)
  8386.   DIM x_spline(anz_max&*schritt_max&),y_spline(anz_max&*schritt_max&)
  8387. RETURN
  8388. PROCEDURE main
  8389.   PRINT CHR$(27);"p"    ! reverse Schrift einschalten
  8390.   REPEAT
  8391.     CLS
  8392.     PRINT AT(1,1);SPACE$(80);
  8393.     PRINT AT(1,1);" linke Maustaste: St
  8394. tzstellen setzen,";
  8395.     PRINT " rechte Maustaste: Interpolation starten."
  8396.     '
  8397.     anz&=-1
  8398.     REPEAT
  8399.       MOUSE mx&,my&,mk&
  8400.       '
  8401.       IF mk&=1 AND my&>16
  8402.         PCIRCLE mx&,my&,2
  8403.         INC anz&
  8404.         x_stuetz(anz&)=mx&
  8405.         y_stuetz(anz&)=my&
  8406.         ATEXT mx&,my&+6,1,STR$(anz&)
  8407.         REPEAT
  8408.         UNTIL MOUSEK=0
  8409.       ENDIF
  8410.       '
  8411.     UNTIL anz&=anz_max& OR mk&=2
  8412.     '
  8413.     IF anz&<2
  8414.       ALERT 1,"Zuwenig Punkte|angegeben!",1,"Weiter",rueck&
  8415.     ELSE
  8416.       ALERT 2,"Ersten|mit letztem|Punkt verbinden ?",1,"Ja|Nein",rueck&
  8417.       '
  8418.       IF rueck&=1                    ! wenn geschlossene Kurve
  8419.         verbinden!=TRUE              ! Flag setzen
  8420.         INC anz&                     ! Anzahl der Stuetzpunkte
  8421.         x_stuetz(anz&)=x_stuetz(0)   ! erhoehen und Koordinaten
  8422.         y_stuetz(anz&)=y_stuetz(0)   ! des letzten Punktes belegen
  8423.       ELSE
  8424.         verbinden!=FALSE
  8425.       ENDIF
  8426.       '
  8427.       schritte&=10   ! mindestens 1, h
  8428. chstens schritt_max&
  8429.       '
  8430.       
  8431. 2' #UMBRUCH ANFANG!
  8432.       ebenen_splines(anz&,schritte&,verbinden!,x_stuetz(),y_stuetz(),
  8433.       x_spline(),y_spline())
  8434.       
  8435. 0' #UMBRUCH ENDE!
  8436.       '
  8437.       ' geschafft, jetzt auf dem Bildschirm ausgeben
  8438.       '
  8439.       ACLIP 1,0,0,639,399
  8440.       anz_spl&=anz&*schritte&
  8441.       '
  8442.       FOR i&=1 TO anz_spl&
  8443.         
  8444. 2' #UMBRUCH ANFANG!
  8445.         ALINE x_spline(PRED(i&)),y_spline(PRED(i&)),x_spline(i&),
  8446.         y_spline(i&),1,&HFFFF,0
  8447.         
  8448. 0' #UMBRUCH ENDE!
  8449.       NEXT i&
  8450.       '
  8451.       ACLIP 0,0,0,639,399
  8452.       '
  8453.       PRINT AT(1,1);SPACE$(80);
  8454.       PRINT AT(1,1);"  Weiter mit beliebiger Taste, Abbruch mit <Esc>"
  8455.       '
  8456.       REPEAT
  8457.       UNTIL INKEY$=""    ! Tastaturpuffer loeschen
  8458.       taste&=INP(2)
  8459.     ENDIF
  8460.     '
  8461.   UNTIL taste&=27        ! Abbruch, wenn <Esc> gedrueckt
  8462.   PRINT CHR$(27);"q"     ! reverse Schrift ausschalten
  8463. RETURN
  8464. 2' #UMBRUCH ANFANG!
  8465. PROCEDURE ebenen_splines(n&,m&,verbind!,VAR
  8466. x_stuetz(),y_stuetz(),x_spline(),y_spline())
  8467. 0' #UMBRUCH ENDE!
  8468.   LOCAL i&,j&,k&
  8469.   IF verbind!                           !\
  8470.     sx=(x_stuetz(1)-x_stuetz(n&-1))*0.5 ! \
  8471.     sy=(y_stuetz(1)-y_stuetz(n&-1))*0.5 !  \   Ableitung
  8472.   ELSE                                  !   >  an den Stuetzpunkten
  8473.     sx=0                                !  /   0 und n gleichsetzen
  8474.     sy=0                                ! /
  8475.   ENDIF                                 !/
  8476.   kub_splines(n&,sx,sx,x_stuetz(),b(),c(),d())
  8477.   h=1/m&
  8478.   k&=0
  8479.   FOR i&=1 TO n&
  8480.     t=-1
  8481.     FOR j&=0 TO m&-1
  8482.       x_spline(k&)=((d(i&)*t+c(i&))*t+b(i&))*t+x_stuetz(i&)
  8483.       ADD t,h
  8484.       INC k&
  8485.     NEXT j&
  8486.   NEXT i&
  8487.   x_spline(k&)=x_stuetz(n&)
  8488.   kub_splines(n&,sy,sy,y_stuetz(),b(),c(),d())
  8489.   k&=0
  8490.   FOR i&=1 TO n&
  8491.     t=-1
  8492.     FOR j&=0 TO m&-1
  8493.       y_spline(k&)=((d(i&)*t+c(i&))*t+b(i&))*t+y_stuetz(i&)
  8494.       ADD t,h
  8495.       INC k&
  8496.     NEXT j&
  8497.   NEXT i&
  8498.   y_spline(k&)=y_stuetz(n&)
  8499. RETURN
  8500. PROCEDURE kub_splines(n&,s0,sn,VAR a(),b(),c(),d())
  8501.   LOCAL n1&,i&,r,dr,s
  8502.   n1&=n&-1
  8503.   b(0)=(a(1)-a(0)-s0)*6
  8504.   FOR i&=1 TO n1&
  8505.     b(i&)=(a(SUCC(i&))-a(i&)*2+a(PRED(i&)))*3
  8506.   NEXT i&
  8507.   b(n&)=(a(n1&)-a(n&)+sn)*6
  8508.   c(0)=b(0)*0.5
  8509.   b(1)=b(1)-b(0)*0.25
  8510.   r=1.75
  8511.   dr=1/r
  8512.   c(1)=b(1)/1.75
  8513.   FOR i&=2 TO n1&
  8514.     s=-0.5*dr
  8515.     ADD b(i&),b(PRED(i&))*s
  8516.     r=s*0.5+2
  8517.     dr=1/r
  8518.     c(i&)=b(i&)*dr
  8519.   NEXT i&
  8520.   s=-dr
  8521.   b(n&)=b(n&)+b(n1&)*s
  8522.   r=s*0.5+2
  8523.   c(n&)=b(n&)/r
  8524.   FOR i&=n1& TO 1 STEP -1
  8525.     IF b(i&)=0
  8526.       temp=1.0E-09
  8527.     ELSE
  8528.       temp=b(i&)
  8529.     ENDIF
  8530.     MUL c(i&),1-c(SUCC(i&))/temp*0.5
  8531.   NEXT i&
  8532.   IF b(0)=0
  8533.     temp=1.0E-09
  8534.   ELSE
  8535.     temp=b(0)
  8536.   ENDIF
  8537.   c(0)=c(0)*(1-c(1)/temp)
  8538.   FOR i&=1 TO n&
  8539.     i_pred&=PRED(i&)
  8540.     b(i&)=a(i&)-a(i_pred&)+(c(i&)*2+c(i_pred&))/6
  8541.     d(i&)=(c(i&)-c(i_pred&))/6
  8542.   NEXT i&
  8543.   FOR i&=1 TO n&
  8544.     MUL c(i&),0.5
  8545.   NEXT i&
  8546. RETURN
  8547. lTOS-Cursor                                                    GFA-Util
  8548. Autor: Peter Harder @ NF
  8549. In den alten Programmen befinden sich h
  8550. ufig noch diverse GFA-
  8551. Befehle, die den TOS-Courser nutzen. Sp
  8552. testens unter MagicMac machen
  8553. diese Programme so viel 
  8554. rger, da
  8555.  etwas passieren mu
  8556. Mit den untenstehenden Routinen k
  8557. nnen schnell die GFA-Befehle PRINT
  8558. AT, PRINT, LOCATE, HTAB, VTAB, CRSCOL, CRSLIN und TAB in alten
  8559. Programmbest
  8560. nden ersetzt werden, da diese Befehle alle den TOS-
  8561. Courser nutzen. Stattdessen wird im Programm ein eigener Courser
  8562. mitgeschleift, der durch die beiden globalen Variablen 
  8563. hhtab_x&
  8564. h und
  8565. hvtab_y&
  8566. d repr
  8567. sentiert wird.
  8568. Die Routinen sollten grunds
  8569. tzlich gemeinsam in ein Programm
  8570. eingesetzt werden, da die beiden Courser-Variablen teilweise in
  8571. vorbelegter Form erwartet werden.
  8572. Kleiner Nebeneffekt: Da der TEXT-Befehl unter 
  8573. $NVDI deutlich schneller
  8574. ist, als der PRINT-Befehl, ergibt sich auch eine deutliche
  8575. Beschleunigung der alten Programme.
  8576. PROCEDURE print_at(x&,y&,text$)
  8577.   TEXT x&*8-8,y&*16-1,text$
  8578.   LET htab_x&=x&+LEN(text$)
  8579.   LET vtab_y&=y&
  8580. RETURN
  8581. PROCEDURE print(text$)
  8582.   TEXT htab_x&*8-8,vtab_y&*16-1,text$
  8583.   ADD htab_x&,LEN(text$)
  8584. RETURN
  8585. PROCEDURE cr_lf
  8586.   ' Zeilenvorschub nach @print() und @print_at()
  8587.   INC vtab_y&
  8588.   LET htab_x&=1
  8589. RETURN
  8590. PROCEDURE locate(x&,y&)
  8591.   LET htab_x&=x&
  8592.   LET vtab_y&=y&
  8593. RETURN
  8594. PROCEDURE htab(x&)
  8595.   LET htab_x&=x&
  8596. RETURN
  8597. PROCEDURE vtab(y&)
  8598.   LET vtab_y&=y&
  8599. RETURN
  8600. FUNCTION crscol
  8601.   $F%
  8602.   RETURN htab_x&
  8603. ENDFUNC
  8604. FUNCTION crslin
  8605.   $F%
  8606.   RETURN vtab_y&
  8607. ENDFUNC
  8608. FUNCTION rspace$(strng$,laenge&)
  8609.   ' Formatiert einen String auf die angegebene L
  8610. nge, indem der String
  8611.   ' rechts abgeschnitten wird oder indem Leerzeichen angeh
  8612. ngt werden.
  8613.   ' Macht u.a. den nicht 
  8614. #GEM-konformen GFA-Befehl TAB() 
  8615. berfl
  8616. ssig.
  8617.   IF laenge&=>0
  8618.     strng$=LEFT$(strng$,laenge&)
  8619.     RETURN strng$+SPACE$(laenge&-LEN(strng$))
  8620.   ELSE
  8621.     RETURN ""
  8622.   ENDIF
  8623. ENDFUNC
  8624. lInlines                                                       GFA-Util
  8625. 14.1 
  8626. 14.2 
  8627. 14.3 
  8628. 14.4 
  8629. 14.5 
  8630. 14.6 
  8631. 14.7 
  8632. 14.8 
  8633. lob_spec%                                                      GFA-Util
  8634. Autor: 
  8635.   @ XYZ
  8636. table
  8637.  !"#$%&'()*+,-./0123456789:;<=>?
  8638. @ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_
  8639. begin 644 OB_SPEC.INL
  8640. M("\ !$CG?_X@0#(O $#"_  8T<$P*  &(&@ #+ \ !AF!B!H  3@0+ \ !1Gz
  8641. M#+ \ !EG!K \ !MF%" (X(#@." 0?H"JA" 0B@  6 @L#P &F<:L#P '&<4y
  8642. <L#P (&<.L#P 'V8&(&@ "& "(% @"$S??_Y.=2@ x
  8643. lcookie%                                                       GFA-Util
  8644. Autor: 
  8645.   @ XYZ
  8646. table
  8647.  !"#$%&'()*+,-./0123456789:;<=>?
  8648. @ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_
  8649. begin 644 COOKIE.INL
  8650. M("\ !$CG?_XF $*G/SP ($Y!+T   B!Y   %H&<,(A@&+*#9P9*@6;T<  Fk
  8651. - $Y!7(\@ TS??_Y.=3P j
  8652. lcrc_code%                                                     GFA-Util
  8653. Autor: 
  8654. 0Christoph Conrad @ AC3
  8655. table
  8656.  !"#$%&'()*+,-./0123456789:;<=>?
  8657. @ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_
  8658. begin 644 CRC_CODE.INL
  8659. H(&\ !#(O  A"0$)#8!06&.%+MT!T!^-(9 0*0! A4<K_]E')_^I.=0 9h
  8660. lsanduhr%                                                      GFA-Util
  8661. Autor: 
  8662.   @ AC3
  8663. table
  8664.  !"#$%&'()*+,-./0123456789:;<=>?
  8665. @ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_
  8666. begin 644 SANDUHR.INL
  8667. M  $  0 !     0, !P /@!_ /^!_\/_X__P__Q__#_X'_ /X ?  X #  P %f
  8668. M  Z &4 PH&"0H(C0]"_[$?T)_@7\ O@!< "@ ,   0 !  $    !  "  O_^e
  8669. M__[__O_^__[__O_^__[__O_^__Z  @       ( "__Z  K@ZQ'["_L'^PO[$d
  8670. M?K@Z@ +__H "       !  $  0    $ P #@ ? #^ ?\#_X?_S____S_^'_Pc
  8671. M/^ ?P ^ !P #  #  * !< +X!?P)_A']+__0_*"(<) PH!E #H %  ,   $ b
  8672. M 0 !     ?_X?_!_\'_P?_!_\'_P?_!_\'_P?_!_\'_P?_#_^   __A/D%_0a
  8673. M7]!?T$^01Q!"$$402)!04%!04%!/D/_X     0 !  $    !__A_\'_P?_!_z
  8674. M\'_P?_!_\'_P?_!_\'_P?_!_\/_X  #_^$^07=!?T%_03Y!'$$(011!(D%!0y
  8675. M4%!24$^0__@    !  $  0    '_^'_P?_!_\'_P?_!_\'_P?_!_\'_P?_!_x
  8676. M\'_P__@  /_X3Y!<T%_07]!/D$<00A!%$$B04%!04%-03Y#_^     $  0 !w
  8677. M     ?_X?_!_\'_P?_!_\'_P?_!_\'_P?_!_\'_P?_#_^   __A/D%C07]!?v
  8678. MT$^01Q!"$$402)!04%)04U!/D/_X     0 !  $    !__A_\'_P?_!_\'_Pu
  8679. M?_!_\'_P?_!_\'_P?_!_\/_X  #_^$^04-!?T%_03Y!'$$(011!(D%!04E!7t
  8680. M4$^0__@    !  $  0    '_^'_P?_!_\'_P?_!_\'_P?_!_\'_P?_!_\'_Ps
  8681. M__@  /_X3Y!04%_07]!/D$<00A!%$$B04%!24%]03Y#_^     $  0 !    r
  8682. M ?_X?_!_\'_P?_!_\'_P?_!_\'_P?_!_\'_P?_#_^   __A/D%!07=!?T$^0q
  8683. M1Q!"$$402)!04%907U!/D/_X     0 !  $    !__A_\'_P?_!_\'_P?_!_p
  8684. M\'_P?_!_\'_P?_!_\/_X  #_^$^04%!<T%_03Y!'$$(011!(D%)05E!?4$^0o
  8685. M__@    !  $  0    '_^'_P?_!_\'_P?_!_\'_P?_!_\'_P?_!_\'_P__@ n
  8686. M /_X3Y!04%C07]!/D$<00A!%$$B04E!64%_03Y#_^     $  0 !     ?_Xm
  8687. M?_!_\'_P?_!_\'_P?_!_\'_P?_!_\'_P?_#_^   __A/D%!04-!?T$^01Q!"l
  8688. M$$402)!24%=07]!/D/_X     0 !  $    !__A_\'_P?_!_\'_P?_!_\'_Pk
  8689. M?_!_\'_P?_!_\/_X  #_^$^04%!04%_03Y!'$$(011!*D%)05U!?T$^0__@ j
  8690. M   !  $  0    '_^'_P?_!_\'_P?_!_\'_P?_!_\'_P?_!_\'_P__@  /_Xi
  8691. M3Y!04%!07=!/D$<00A!%$$B04E!?T%_03Y#_^     $  0 !     ?_X?_!_h
  8692. M\'_P?_!_\'_P?_!_\'_P?_!_\'_P?_#_^   __A/D%!04%!9T$^01Q!"$$40g
  8693. M2)!64%_07]!/D/_X     0 !  $    !__A_\'_P?_!_\'_P?_!_\'_P?_!_f
  8694. M\'_P?_!_\/_X  #_^$^04%!04%C03Y!'$$(011!(D%=07]!?T$^0__@    !e
  8695. M  $  0    '_^'_P?_!_\'_P?_!_\'_P?_!_\'_P?_!_\'_P__@  /_X3Y!0d
  8696. M4%!04-!/D$<00A!%$$B07U!?T%_03Y#_^     $  0 !     ?_X?_!_\'_Pc
  8697. M?_!_\'_P?_!_\'_P?_!_\'_P?_#_^   __A/D%!04%!04$^01Q!"$$402I!?b
  8698. M4%_07]!/D/_X     0 !  $    !__A_\'_P?_!_\'_P?_!_\'_P?_!_\'_Pa
  8699. M?_!_\/_X  #_^$^04%!04%!039!'$$(011!*D%_07]!?T$^0__@    !  $ z
  8700. M 0    '_^'_P?_!_\'_P?_!_\'_P?_!_\'_P?_!_\'_P__@  /_X3Y!04%!0y
  8701. M4%!)D$<00A!%$$Z07]!?T%_03Y#_^     $  0 !     ?_X?_!_\'_P?_!_x
  8702. M\'_P?_!_\'_P?_!_\'_P?_#_^   __A/D%!04%!04$B01Q!"$$403Y!?T%_0w
  8703. M7]!/D/_X     0 !  $    !__A_\'_P?_!_\'_P?_!_\'_P?_!_\'_P?_!_v
  8704. E\/_X  #_^$^04%!04%!02)!%$$(01Q!/D%_07]!?T$^0__@  /!_u
  8705. lbusymouse%                                                    GFA-Util
  8706. Autor: 
  8707.   @ AC3
  8708. table
  8709.  !"#$%&'()*+,-./0123456789:;<=>?
  8710. @ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_
  8711. begin 644 BUSYMAUS.INL
  8712. M       !     0_P/_Q__G_^_____________________W_^?_X__ _P   'z
  8713. MX!CX(/P@_$#^0/Y _G\"?P)_!C\$/PP?& ?@          $    !#_ __'_^y
  8714. M?_[_____________________?_Y__C_\#_    ?@&!@'" \<#Y\?G_^?_Y^x
  8715. M/GP./ 0X!!@8!^           0    $/\#_\?_Y__O__________________w
  8716. M__]__G_^/_P/\   !^ 8&# ,.!Q\/GY^?_Y__GY^?#XX'# ,&!@'X       v
  8717. M   !     0_P/_Q__G_^_____________________W_^?_X__ _P   'X!@8u
  8718. M. 0\!'P.?CY__G_^?'YP/B \(!P8& ?@          $    !#_ __'_^?_[_t
  8719. M____________________?_Y__C_\#_    ?@'Q@_##\$?P9_ G\"0/Y _D#^s
  8720. M(/P@_!CX!^           0    $/\#_\?_Y__O____________________]_r
  8721. M_G_^/_P/\   !^ ?^#_D/\1?PD>"08)!@D'B0_HC_"?\'_@'X          !q
  8722. M     0_P/_Q__G_^_____________________W_^?_X__ _P   'X!_X/_POp
  8723. M]$?B0\)!@D&"0\)'XB_T/_P?^ ?@          $    !#_ __'_^?_[_____o
  8724. M________________?_Y__C_\#_    ?@'_@G_"/\0_I!XD&"08)'@E_"/\0_n
  8725. 'Y!_X!^   /__m
  8726. lboyer_adr%                                                    GFA-Util
  8727. Autor: 
  8728.   @ XYZ
  8729. table
  8730.  !"#$%&'()*+,-./0123456789:;<=>?
  8731. @ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_
  8732. begin 644 BM.INL
  8733. M2.]__O_(+&\ %C(O !!G  #^LGP  FT  ,J]_     !G$B!O  Q"0%-!$! 0z
  8734. M]@  4<G_^"!O !(^+P 0,#P _Q#'4<C__"!O  S0QR)O !)\ $) $""^,0  y
  8735. M9@03A@  4D:^1F+L(&\ !"PO  AG  ">0?!P_R1O  Q%\G#_)F\ $G( $! 2x
  8736. M$KW\     &<$$#8  +( 9QH2,P  :Q#0P9R!:MYP $SO?_[_R$YU1$%@[#H'w
  8737. M544H2"I*$"02);W\     &<$$#8  +( 9P9!Z  !8*Y1S?_D( Q,[W_^_\A.v
  8738. M=2)O  P@;P $*$C9[P (%A&]_     !F'KG(;1"V&&;X( A3@$SO?_[_R$YUu
  8739. M< !,[W_^_\A.=4)!QGP _Q8V, "YR&WH$A@2-A  M@%F\B (4X!,[W_^_\A.t
  8740. !=0!,s
  8741. lctab%                                                         GFA-Util
  8742. Autor: 
  8743.   @ XYZ
  8744. table
  8745.  !"#$%&'()*+,-./0123456789:;<=>?
  8746. @ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_
  8747. begin 644 CTAB.INL
  8748. M  $" P0%!@<("0H+# T.#Q 1$A,4%187&!D:&QP='A\@(2(C)"4F)R@I*BLLq
  8749. M+2XO,#$R,S0U-C<X.3H[/#T^/T!!0D-$149'2$E*2TQ-3D]045)35%565UA9p
  8750. M6EM<75Y?8$%"0T1%1D=(24I+3$U.3U!14E-455976%E:>WQ]?G^ FH*#CH6&o
  8751. MAXB)BHN,C8Z/D)&2DYF5EI>8F9J;G)V>GZ"AHJ.DI::GJ*FJJZRMKJ^PL;*Sn
  8752. MM+6VM[BYNKN\O;Z_P,'"P\3%QL?(R<K+S,W.S]#1TM/4U=;7V-G:V]S=WM_@m
  8753. ?X>+CY.7FY^CIZNOL[>[O\/'R\_3U]O?X^?K[_/W^_]/4l
  8754. lcntlines%                                                     GFA-Util
  8755. Autor: 
  8756. *Ulf Dunkel @ CLP
  8757. lCNTLINES als INLINE:
  8758. table
  8759.  !"#$%&'()*+,-./0123456789:;<=>?
  8760. @ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_
  8761. begin 644 CNTLINES.INL
  8762. M(&\ !"(O  AP %.!) %(0B8(#!@ "F<*4<G_^%'*__1.=5* EHBVO/__@OYKz
  8763. )!"8(8.9P_TYUy
  8764. lHEX-Dump von CNTLINES.INL:
  8765. 0000: 206F 0004  222F 0008  7000 5381  2401 4842
  8766. 0010: 2608 0C18  000A 670A  51C9 FFF8  51CA FFF4
  8767. 0020: 4E75 5280  9688 B6BC  FFFF 82FE  6B04 2608
  8768. 0030: 60E6 70FF  4E75
  8769. lAndere UUE's                                                  GFA-Util
  8770. 15.1 
  8771. 15.2 
  8772. lverybusy.uue                                                  GFA-Util
  8773. Autor: 
  8774. ,Ulli Gruszka @ DO, 
  8775.   @ AC3
  8776. begin 644 VERYBUSY.LZH
  8777. M)SLM;&@U+6L   "P    ;(/F'B  $59%4EE"55-97$)54UDN2%)$@>0 7E-Vz
  8778. ML34&,2*R-)IL:S97:FT6<FX@1,!.Y)O)1)_:8!"&VS!G1O_P<^B:>6<+DWX4y
  8779. MI N6<5^@N=;24P?4D2FH/M>-Q!]W2H[:/\?B7>/RUL://:J>D-T)F@7W4JQWx
  8780. M2:E/.T$N> Q3%G$9$"=>+6QH-2VO"P  )"X  &R#YAX@ !%615)90E5365Q"w
  8781. M55-9+E)30U<V",!\'>V;379[V226!0MEN "6V6SZ6VVVVVA<;9:4K9* --M@v
  8782. MM00#9#4@6:E2V6LM.0W&D^M#_0XV<5SC.>>4N3+EVX<*J(\YQ"IESGGD5<N5u
  8783. M7F W*JN6@Y6!I9]YY]]+[;][C8V_FGJU>W"&PX-D=L[&SW+W/X&KS^$CUNU:t
  8784. MBDVI"$H8VMC:W&XL=LYEG,DF26)%H1] 1/6/F1!D)A^X22(L)FB8L.>0(MD5s
  8785. M)W1DDB+4@T1HI QN+(O /DP\L2+B1@3QTE(N I5<2.#RO3'M0BK"$C:T/58$r
  8786. MM81@6.&HVX3H<8\8:/\$*74CK31^\)&Q(\:3#$PY:W%6KDT7AS5O^<M;L5:'q
  8787. MQ$>6M\<3$$QN#0[,*#F@\XE6A\11EH>.-0^;+0\>:/:E7[(T?L"K^0-'W 69p
  8788. MJ1Y$T?[8-=2/SAH\(F*B1\4K'Q,L#+4CXLT=P#A4CXPT?2!>BI'QIH^M #$Mo
  8789. MG-'^ 27B1Y(+*6>#9O3C?F'G'*V;XGNRV;RY),C8H\88W>KB2AA_Y2CVBM;Qn
  8790. MV)+;/*FCX\ML\L:/5EMG:FCO"VSH&C]>6V=L:/MRVSR1H_?%MGF#9%ZL%.Q)m
  8791. MD CT898\A@N^5!WCA7FE7?'<(KOFU:?CVA7?.&CTY7?.FCZ,KOGC1[<KOGS1l
  8792. M^S*[Z T?YQ7?0FC_C*[Z)6.RC2X5\>:/0EPKY T?-%PKS!H]F7"OSQ.=)D38k
  8793. M)XX+.5Q,BK9NRZXMF]&:A_CD81(]*3GR9+!H>.#>*"A^@-0_V"T/ZPU#P2V_j
  8794. M^M5CR$F6W^D-'IBV_Y(T?IRV_\\:.B6W]N'RBT^"IVP$8\%/3*J>0]\53^N-i
  8795. M0^[*IZ<T?\)5/2JQY'#%4^:(X)F36SR)* *WJ%:WD9\M;Y0U#](6M\J:.[+6h
  8796. M^6-'N2UOES1_BEL?]>:/]<
  8797. "MC]2:/^PN)_,*Q^<9EQ/]":/2EQ/]$:/H2XG^Cg
  8798. M-'>EQ/](:/=%Q/YDT>[#.G$O'-'O"3L2.0E41T:V?&!\#:XE6K;/BHPML_L%f
  8799. M:'Q4Z E2/FS1^B+CGSAH]@6W_V)H_6AE#4CYTT?;!]?JD?/&C_5+<OGS1_!(e
  8800. MRB1] K'Q>-#!ZI'Z4T>D+=?TQH_3!8*I']D:/JP^X]2/H31_>EO'T1H[\DI$d
  8801. "MC].:/O@^6]2/6*Q\8O+>_HS1YL,NZD=R:/F"3$2/I#1_9EOWTIH_6$G(D>M-c
  8802. M'^&2>B1W1H^\#+G$S'Q(Z"<?@$HE(Z?YCXSA_F/RH93?#_,>BG08_F/7)QU,b
  8803. M-ZP!ZT-Y,,,2\P_N S?KTQ[ T<?CW8)UW&*Q\=-A'C"8\<5<2.FI\=G4_KO3a
  8804. MCA^E4C/+!#UL@0NI E_R88)M:'G6@!_^.![,/.[ #<' WA"22\ .NB@9($/)z
  8805. M"A]>AX8%@&XQ,""'DA0^P0BT&"'DA0_5GJ4$/)BA^LB@9,$/)BA_;' @AY,4y
  8806. M/UIP((>3%#[$X$$/*"A[F*!E 0\H*']N<""'E!0_7' @AY04/[@X$$.T%#]?x
  8807. M% M 0[04/LC@00[04/V!P((=H*']R%W,8&'OQ;VV@(>5%#^ZD/(O]E00\J*'w
  8808. M]V<""'E10_O#@00\J*'V9P((>6%#]E% RP(>6%#[0X$$/+"A_?G @AY84/VAv
  8809. MP((=J*'^%% M00[44/VQP((=J*'VIP((=J*'[<X$$.@*'^)% H AT!0_QC@0u
  8810. M0Z H?Y!P((= 4/\DX$$.V%#_*B@6P(=L*'^6<""';"A_F' @AVPH?<G @AY<t
  8811. M4/NHH&7!#RXH?YIP((>7%#]T<""'EQ0_SS@00\P*'^A% S (>8%#_1.!!#S s
  8812. MH?Z1P((>8%#_3.!!#S(H?ZD4#,@AYD4/]8X$$/,BA^].!!#S(H?[)P((>:%#r
  8813. M_:B@9H$/-"A_N' @AYH4/]XX$$/-"A_OG @AYL4/O8H&;!#S8H?\!P((>;%#q
  8814. M]^<""'FQ0_XC@00\X*'_)% S@(><%#_F.!!#S@H?P#@00\X*'_2<""'G10^_p
  8815. MB@9T$/.BA_U' @AYT4/^LX$$/.BA_VG @AYX4/P8H&>!#SPH?PC@00\\*'OCo
  8816. M@00\\*'2.!!#SX(=FLB@9\$//@AV:XX$$//@AV; X$$//@AV;$X$$/0"A\/%n
  8817. M T (>@%#X@X$$/0"AXXX$$/0"AV1P((>A%#R,4#0@AZ$4/BC@00]"*'QAP((m
  8818. M>A%#XXX$$/1"AY**!H@0]$*'E#@00]$*'E3@00]$*':G @A\>*';<4#F7.HMl
  8819. M.I=5]<Z>.7=?8N;6OLG;IVAE;*SU3ROKM-:H3NEGD.=R62Y_(9+H$-)JD,[8k
  8820. M6%>A4O )Z=R3/NJ^U=/'2'%H,!N9<N^H>.JU#.6FJT]D\)_BJ]+IK1U8(5KIj
  8821. MXAG'7M-0Z=]2A?ZI0H-W:O+*PH4,YIJ_J+5"R$+46 )QVYM71,\Z>6#EW76Ci
  8822. MFQU#NN3H&HOZ_ V*5M7-I:ND+"O=Z>T)E'5II=-8.M0[KZ[Q1RHUX"1M;0E6h
  8823. M\LJYXYL;%T[K72'#U2H91U7UKK *.R?^TQ@-8+>$^AOH:6#H>=O":P6,!2?6g
  8824. M<*JX&NWNLW5L&M9NM=O:K@5G"5GX1]G!0A.(;B&BD.TE@[?+7RUNO:L^0?9Hf
  8825. M+[./U,M";PWPTW#?0F^IEK./07L^0?:LVZ\:O4KE1"BCT(3,)Z7\-#6%TPVOe
  8826. MM;ICV^7NF';.KIAN;Y%9L;[8;+8;+J]EW>,?)>F?[\=]XP?)>4_W"UPM16#;d
  8827. MV-P:*P>?DO^_/J7<J7B^>?J+<3>QW^QWX^]1;^<?J+>IWPF]GP=GP1]ZG?5%c
  8828. MOYA]MK:G?57 $WN;[<WP^]5P*G?-M;R3\Y>5G"K.$)ON>J[GJA]QYYR\\O!^b
  8829. M5/CAY4Q"\6?_$^)V"U@M1H'SS[UZ)N]97K(?=Z]\X^]>ZF6$V%',1]]3+/7Oa
  8830. MF'Z?5CEO$V_7/UP^XYCZ?5\D_2--'&:.,$V&+[6#[CSTC03X=)1IB:LD)9"7z
  8831. M0F,)DGM</']UB_8HL44___LR4A-22"L@KH+&"2"3OEFO6(K@ZI%_OXOVL&<Ay
  8832. M96'E8=LE;<&VWNNMMF' ^NWUVWO/^_'_2(4SAZX>P$H*E.-4F+U:]6TR]I_Sx
  8833. MY/VC.F7C5Z3%)/MJ<%* D*/0IF=)_KY?^1=_>#;>D%O.NMK;>A<*D-Q\XI3[w
  8834. M]K>MX+Z$^A)0[_8\H9:KUB_# ^_9T;;#5"^H7VRVV6]E&VRU%:X7N%[;#,Z-v
  8835. M2?QS[C+.,LC;HV_J'P(HY%&[VD:CZI\#.TX7^3\:C=HY'FGQL_&P4;#>:?&Xu
  8836. M4;C>:?MUMNMRR_+>F_^RV%PM['^]G^YV'JV_]BMN K_TCXO$7SQ,/ZY%E 4Vt
  8837. MW@MX;=)3<3042/:9E[@?(=.+O9!I(<X&VC6]2AN%[>"'=X8'DGU#H]K0\<^Fs
  8838. ML3Z"B88/%<IO6)ZO^5%<I/_D?R:>RE]PGOS#]^/+7\2C_YG\F.\&OXG/S#]_r
  8839. M7_-/^)[I8%U/D:(1%9MP[27MUB-BDDC8J\:(]IC)QC]Q'))7$=M@[8_MG*O'q
  8840. MR3_$KF)Q^6?XE<J<?'/C^WV QNF'%]=J'[C^,?_<;_1VG&/X1OM>]@,>8OU3p
  8841. M8HGEK_Q#?@<I?^.;[7NO*7\4WQU_A&Q]?)/X1L:!\D_A&^3;_%-\=?X1OD+_o
  8842. M]YOF8/__U_!?7L7:0_0_!JKFLW@[JKFID,I(9>0S%S5IZJKE2?QC^B\8_F^4n
  8843. M?T/C'\YRC^@\4_F_-/U?C'\_RS]7Q#]9YI_1<,_GOZ']"8_F_ZG]!Q#^\Y9^m
  8844. MKX9_/\P_5X!_HO[']$:OU+C^6?Z7!/Y[T#^@P3^?] _5X)^L]$_5X%G_I'\Sl
  8845. M@']YZ)_H8A_->F?S$0_5>H?RX'ZGAGUQ&)&2+5^W@#BO2A-P_Y(RAL82Z"LOk
  8846. M20"/UP==VCT9)Q1W6CN;K7[SP<AX4C?8>&PA+8*RS)=$#]X**W _?RKM%:IUj
  8847. M:$9X?H#I=V]NX>ZAW</=O=Q2J0TYS\D!9>AT1>$RAM1_0?"'*BW@-7[)%B/1i
  8848. ?(7Y+I99K8+"%AX<C?9!+>0KK7V=S1W4DXCT6 =%! -1_h
  8849. lprozess.rsc                                                   GFA-Util
  8850. Autor: 
  8851.   @ KR
  8852. begin 644 PROZESS.LZH
  8853. M(6\M;&@U+:$   #D    6J7T'B  "U!23UI%4U,N4E-#_0( CEMRV:5A?QC$z
  8854. M:OB0J-#]8ST:++XK0:C0;(K^PT!Q)L4FN\ &D<#'@<<!M^:,?2>AL!I, :QAy
  8855. M]N*74)A(/Z8Y(X00.44)G^!4\2%_HS!4$@S_%>"Y43EDK_Q_:U(]TQZZTM$1x
  8856. M83R(/,O1]7T([R'ICWU"3@PW%94UI=6&7KF;G]*W,[7D^\ZS:-Y][B-C3>7%w
  8857. MUW@WOV;:K;#:7DK:BW4\@"&A+6QH-2TS    0P   %NE]!X@  M04D]:15-3v
  8858. M+DA21'_* "I*MHTH)W%3YGX<HL(BR8C;Z6HYT "$"*DD*?KF?!Q^1>+PV4FSu
  8859. MV]G7:3?[+G#:%%T (98M;&@U+84   "[    6Z7T'B  "U!23UI%4U,N3%-4t
  8860. M218 ?5*6H:45YT'O_<.N2HKEW XVD2SE,Y"'CQ6HP*H9MPW'>-25==.  "5Hs
  8861. MI"W9Y1AT<#M\.>*,>K_+LQV]0%:ZKD66"637*E#!6::VDA=HU#CE#"-[8;#Or
  8862. M;?EWED]O90Q"2%W:06,70J</Q!FQP^=#[-.NU1R%WZ3&JY_HS3)Y(40O#_( q
  8863. ! /EWp
  8864. lProtokolle                                                    GFA-Util
  8865.  Drag & Drop:    
  8866.                  
  8867. .Font-Protokoll: 
  8868.  AV-Protokoll:
  8869. lDrag & Drop (nach Lorenz)                                     GFA-Util
  8870. Autor: 
  8871. 0Alexander Lorenz @ N
  8872. Nachfolgend der Receiver-Teil der Routinen. Sie sind nicht besonders
  8873. n und schon gar nicht 
  8874. bersichtlich :-)), aber sie funktionieren.
  8875. Es ist problemlos m
  8876. glich, auch den Sender-Teil in GFA zu
  8877. verwirklichen, nur mu
  8878.  dieser relativ tief in den Source eingebunden
  8879. werden. Wenn die Zeit da ist, werde ich mich mal dransetzen, und
  8880. separate Routinen daraus machen.
  8881. ' MultiTOS-Drag&Drop-Library
  8882. ' Konstanten f
  8883. r D&D-Protokoll
  8884. Dd_ok&=0
  8885. Dd_nak&=1
  8886. Dd_ext&=2
  8887. Dd_len&=3
  8888. Dd_trash&=4
  8889. Dd_printer&=5
  8890. Dd_clipboard&=6
  8891. Dd_path$="U:\PIPE\DRAGDROP."
  8892. ' Buffer f
  8893. r I/O-Routinen
  8894. Inline Buffer%,1024
  8895. ' Die folgenden Zeilen geh
  8896. ren in die Event-Auswertung!!!
  8897. ' -----------------
  8898. &Select Event&
  8899. Case 63
  8900.   ' AP_DRAGDROP
  8901.   Handle&=Menu&(3)
  8902.   F$=String$(2,Chr$(0))
  8903.   Bmove V:Menu&(7),V:F$,2
  8904.   Dd_receive(Handle&,F$,Daten$,Adr%,Len%)
  8905.   If Adr%>0
  8906.     Print "Empfangener Datentyp: ";Daten$
  8907.     Print "
  8908. 'Adresse: ";Adr%
  8909.     Print "L
  8910. nge: ";Len%
  8911.     '
  8912.     ' hier ggf. die Daten auswerten!
  8913.     '
  8914.     ~
  8915. %Mfree(Adr%)
  8916.   Else
  8917.     Print "Keine Daten empfangen!"
  8918.   Endif
  8919. Endselect
  8920. ' -----------------
  8921. '   Drag&Drop Receive-Routine
  8922. Procedure Dd_receive(Handle&,F$,Var Daten$,Mem%,Byte_len%)
  8923.   ' AP_DRAGDROP-Msg auswerten
  8924.   '   Handle&  -  Fensterhandle von AP_DRAGDROP
  8925.   '        F$  -  Extension von AP_DRAGDROP
  8926.   '    Daten$  -  Empfangener Datentyp ("ARGS" etc.)
  8927.   '      Mem%  -  
  8928. 'Adresse der Daten
  8929.   ' Byte_len%  -  L
  8930. nge der Daten bzw. des Speicherblocks
  8931.   Dd_open(Dd_path$+F$,File_hdl&)
  8932.   If File_hdl&>0
  8933.     '
  8934.     ' Protokoll starten
  8935.     '
  8936.     Dd_reply(File_hdl&,Dd_ok&)
  8937.     '
  8938.     ' unsere Datentypen senden
  8939.     '
  8940.     Dd_datatypes(File_hdl&)
  8941.     '
  8942.     Dd_msg&=Dd_ext&
  8943.     '
  8944.     ' einige Laufvariablen
  8945.     '
  8946.     Cnt%=0
  8947.     Mem%=0
  8948.     Byte_len%=0
  8949.     '
  8950.     Repeat
  8951.       '
  8952.       ' Headerl
  8953. nge lesen
  8954.       '
  8955.       
  8956. %Fread(File_hdl&,Buffer%,2)
  8957.       If Return%>0
  8958.         '
  8959.         ' Header lesen & auswerten
  8960.         '
  8961.         Len%=Min(Card{Buffer%},1024)
  8962.         '
  8963.         
  8964. %Fread(File_hdl&,Buffer%,Len%)
  8965.         If Return%>0
  8966.           '
  8967.           Daten$=String$(4,Chr$(0))
  8968.           Bmove Buffer%,V:Daten$,4        !Datentyp
  8969.           '
  8970.           Byte_len%=Long{Buffer%+4}       !Datenl
  8971.           '
  8972.           If Daten$=".
  8973. #GEM"
  8974.             Dd_msg&=Dd_ok&
  8975.           Else if Daten$=".IMG"
  8976.             Dd_msg&=Dd_ok&
  8977.           Else if Daten$=".GFA"
  8978.             Dd_msg&=Dd_ok&
  8979.           Else if Daten$=".TXT" Or Daten$=".ASC"
  8980.             Dd_msg&=Dd_ok&
  8981.           Else if Daten$=".LST"
  8982.             Dd_msg&=Dd_ok&
  8983.           Else if Daten$="ARGS"
  8984.             Dd_msg&=Dd_ok&
  8985.           Else if Daten$="PATH"
  8986.             '
  8987.             ' Geh
  8988. rt das Fenster zu uns?
  8989.             '  (hier mu
  8990. rlich die Routine des
  8991.             '   eigenen Programms aufgerufen werden!)
  8992.             '
  8993.             Get_wind_opt(Handle&,W_nr%)
  8994.             '
  8995.             ' W_nr%  -  >=0: Fenster geh
  8996. rt zu uns
  8997.             '            -1: Fenster geh
  8998. rt nicht zu uns
  8999.             '
  9000.             If W_nr%<>-1
  9001.               If Wind_typ&(W_nr%)=1
  9002.                 '
  9003.                 ' Dokumentfenster (Fenster hat einen Pfad)
  9004.                 '
  9005.                 Get_filename(Handle&,B$)
  9006.                 '
  9007.                 ' B$ enth
  9008. lt jetzt den Pfad incl. Dateiname!
  9009.                 '
  9010.                 Dd_msg&=Dd_ok&
  9011.                 B$=Trim$(B$)+Chr$(0)
  9012.               Else
  9013.                 Dd_msg&=Dd_nak&
  9014.               Endif
  9015.             Else
  9016.               Dd_msg&=Dd_nak&
  9017.             Endif
  9018.             '
  9019.           Else
  9020.             Dd_msg&=Dd_ext&
  9021.           Endif
  9022.           '
  9023.           If Dd_msg&>=0
  9024.             '
  9025.             If Dd_msg&=Dd_ok& And Daten$<>"PATH"
  9026.               '
  9027.               ' Datenpuffer anfordern
  9028.               '
  9029.               Mem%=
  9030. &Malloc(Byte_len%,Mem%)
  9031.               If Mem%<=0
  9032.                 Dd_msg&=Dd_len&
  9033.               Endif
  9034.             Endif
  9035.             '
  9036.             Dd_reply(File_hdl&,Dd_msg&)
  9037.             '
  9038.             If Dd_msg&=Dd_ok& And Daten$="PATH"
  9039.               If Daten$="PATH"
  9040.                 '
  9041.                 ' Fensterpfad senden
  9042.                 '
  9043.                 Char{Buffer%}=B$
  9044.                 
  9045. &Fwrite(File_hdl&,Buffer%,Min(Len(B$),Len%))
  9046.               Endif
  9047.             Else if Dd_msg&=Dd_len&
  9048.               Dd_datatypes(File_hdl&)
  9049.             Endif
  9050.             '
  9051.             Inc Cnt%
  9052.             '
  9053.           Endif
  9054.           '
  9055.           Return%=1
  9056.           '
  9057.         Endif
  9058.       Endif
  9059.       '
  9060.     Until Dd_msg&<=0 Or Cnt%>8 Or Return%<=0
  9061.     '
  9062.     ' D&D ist ok bzw. wird abgebrochen
  9063.     '
  9064.     If Return%>0
  9065.       If Cnt%>8 And Dd_msg&<>Dd_ok&
  9066.         '
  9067.         ' Drag & Drop abbrechen
  9068.         '
  9069.         Dd_reply(File_hdl&,Dd_nak&)
  9070.       Else if Dd_msg&=Dd_ok& And Cnt%<=8
  9071.         '
  9072.         ' Daten aus Pipe lesen
  9073.         '
  9074.         If Mem%>0
  9075.           
  9076. %Fread(File_hdl&,Mem%,Byte_len%)
  9077.         Endif
  9078.       Endif
  9079.     Endif
  9080.     '
  9081.     Dd_close(File_hdl&)
  9082.   Endif
  9083. Return
  9084. '   Drag&Drop Library
  9085. Procedure Dd_open(F$,Var File_hdl&)
  9086. %Fopen(F$,2,File_hdl&)
  9087. Return
  9088. Procedure Dd_close(File_hdl&)
  9089. &Fclose(File_hdl&)
  9090. Return
  9091. Procedure Dd_reply(File_hdl&,Flg&)
  9092.   Byte{Buffer%}=Flg&
  9093. &Fwrite(File_hdl&,Buffer%,1)
  9094. Return
  9095. Procedure Dd_datatypes(File_hdl&)
  9096.   Char{Buffer%}="ARGS"
  9097.   Char{Buffer%+4}="PATH"
  9098.   Char{Buffer%+8}=".
  9099. #GEM"
  9100.   Char{Buffer%+12}=".IMG"
  9101.   Char{Buffer%+16}=".GFA"
  9102.   Char{Buffer%+20}=".TXT"
  9103.   Char{Buffer%+24}=".ASC"
  9104.   Char{Buffer%+28}=".LST"
  9105. &Fwrite(File_hdl&,Buffer%,32)
  9106. Return
  9107.   Library
  9108. Procedure 
  9109. %Fopen(Datei$,Flg%,Var File_hdl&)
  9110.   Datei$=Datei$+Chr$(0)
  9111.   Adr%=V:Datei$
  9112.   File_hdl&=Gemdos(61,L:Adr%,W:Flg%)
  9113. Return
  9114. Procedure 
  9115. &Fclose(File_hdl&)
  9116.   Return%=Gemdos(62,W:File_hdl&)
  9117. Return
  9118. Procedure 
  9119. %Fread(File_hdl&,Adr%,Flg%)
  9120.   Return%=Gemdos(63,W:File_hdl&,L:Flg%,L:Adr%)
  9121. Return
  9122. Procedure 
  9123. &Fwrite(File_hdl&,Adr%,Flg%)
  9124.   Return%=Gemdos(64,W:File_hdl&,L:Flg%,L:Adr%)
  9125. Return
  9126. lDrag & Drop (nach R
  9127. ger)                                      GFA-Util
  9128. Autor: Frank R
  9129. ger @ OS2
  9130. PROCEDURE menue_warten
  9131.     '
  9132. 2' #UMBRUCH ANFANG!
  9133.     ev_mul&=EVNT_MULTI(mu_keybd&+mu_button&+mu_mesag&,258,3,0,0,
  9134.     0,0,0,0,0,0,0,0,0,mbuf%,0,pmx&,pmy&,pmb&,pks&,pkr&,pbr&)
  9135. 0' #UMBRUCH ENDE!
  9136.     '
  9137.     IF BTST(ev_mul&,mub_mesag&)
  9138.       SELECT @mbuf(0)
  9139.       CASE ap_dragdrop&
  9140.         do_ap_dragdrop(WORD(@mbuf(7)))
  9141.       ENDSELECT
  9142.     ENDIF
  9143.     '
  9144.   LOOP
  9145. RETURN
  9146. PROCEDURE do_ap_dragdrop(dragdrop&)
  9147.   LOCAL dummy!
  9148.   LOCAL dummy$
  9149.   CLR cmd$
  9150.   IF @chk_pipe(dragdrop&,cmd$)
  9151.     dd!=-1
  9152.     dummy$=cmd$
  9153.     ~@cut_left_str(dummy$,cmd$)
  9154.     IF LEN(cmd$)
  9155.       IF EXIST(cmd$)<>0
  9156.         IF UPPER$(RIGHT$(cmd$,4))=".SGI"
  9157.           windup(beg_mctrl&)
  9158.           menue_on(m.t.para&)
  9159.           sgi_laden(cmd$)
  9160.           windup(end_mctrl&)
  9161.         ELSE
  9162.           menue_on(m.t.datei&)
  9163.           ~@liste_laden(0,0,0,0,0,dummy!,dummy!)
  9164.         ENDIF
  9165.         menue_off
  9166.       ELSE
  9167.         
  9168. 2' #UMBRUCH ANFANG!
  9169.         ~@my_alert(note&,"Datei:|"+@pfad_format$(cmd$,40)+"|nicht
  9170.         gefunden!",1,"Abbruch")
  9171.         
  9172. 0' #UMBRUCH ENDE!
  9173.         '
  9174.       ENDIF
  9175.     ENDIF
  9176.     CLR dd!
  9177.   ELSE
  9178.     cmd$=TRIM$(cmd$)
  9179.     IF LEN(cmd$)>40
  9180.       cmd$=LEFT$(cmd$,40)+"|"+MID$(cmd$,41,40)
  9181.     ELSE IF LEN(cmd$)=0
  9182.       '
  9183.       
  9184. 2' #UMBRUCH ANFANG!
  9185.       cmd$="Keine! Evtl. gab es auch einen Fehler|bei der DragDrop-
  9186.       Kommunikation (Pipe)!"
  9187.       
  9188. 0' #UMBRUCH ENDE!
  9189.       '
  9190.     ENDIF
  9191.     '
  9192. 2' #UMBRUCH ANFANG!
  9193.     ~@my_alert(note&,"Sorry, SaugUtil unterst
  9194. tzt nur den|DragDrop-
  9195.     Datentyp 'ARGS' (Listenname)!|Angeboten wurden leider nur
  9196.     folgende:|"+cmd$,1,"Schade")
  9197. 0' #UMBRUCH ENDE!
  9198.     '
  9199.   ENDIF
  9200.   CLR cmd$
  9201. RETURN
  9202. FUNCTION chk_pipe(dragdrop&,VAR pipeliste$)
  9203.   $F%
  9204.   LOCAL pipehandle&
  9205.   LOCAL pipemsglen&
  9206.   LOCAL pipe$
  9207.   ' LOCAL pipedataname$
  9208.   LOCAL pipemsg$
  9209.   LOCAL pipemsglen$
  9210.   pipe$="U:\PIPE\DRAGDROP."+MKI$(dragdrop&)
  9211.   IF EXIST(pipe$)<>0
  9212.     pipehandle&=@fopen(readwrite&,pipe$)
  9213.     IF pipehandle&>-1
  9214.       REPEAT
  9215.         EXIT IF @fwrite(pipehandle&,CHR$(dd_ok&),0)
  9216.         EXIT IF @fwrite(pipehandle&,"ARGS"+STRING$(28,0),0)
  9217.         DO
  9218.           EXIT IF @fread(pipehandle&,2,pipemsglen$)
  9219.           pipemsglen&=CVI(pipemsglen$)
  9220.           EXIT IF @fread(pipehandle&,pipemsglen&,pipemsg$)
  9221.           IF INSTR(pipemsg$,"ARGS")=1
  9222.             EXIT IF @fwrite(pipehandle&,CHR$(dd_ok&),0)
  9223.             EXIT IF @fread(pipehandle&,CVL(MID$(pipemsg$,5)),pipeliste$)
  9224.             ~@fclose(pipehandle&,pipe$)
  9225.             ' pipedataname$=MID$(pipemsg$,9)
  9226.             RETURN -1
  9227.           ELSE
  9228.             '
  9229.             
  9230. 2' #UMBRUCH ANFANG!
  9231.             pipeliste$=pipeliste$+STRING$(-
  9232.             (LEN(pipeliste$)>0),"/")+LEFT$(pipemsg$,4)
  9233.             
  9234. 0' #UMBRUCH ENDE!
  9235.             '
  9236.             EXIT IF @fwrite(pipehandle&,CHR$(dd_ext&),0)
  9237.           ENDIF
  9238.         LOOP
  9239.       UNTIL -1
  9240.       ~@fclose(pipehandle&,pipe$)
  9241.     ENDIF
  9242.   ENDIF
  9243.   RETURN 0
  9244. ENDFUNC
  9245. Bemerkungen dazu:
  9246.   1. FUNCTION mbuf(i&) liefert das entsprechende WORD aus dem
  9247.      Messagebuffer, den ich mit M[x]alloc() alloziere.
  9248.   2. dd! und cmd$ sind globale Variablen f
  9249. r meine Ladefunktion.
  9250.      Wichtig ist, da
  9251.  chk_pipe() in VAR pipeliste$ die Kommandozeile
  9252.      liefert, wenn alles klappt! Sonst enth
  9253. lt pipeliste$ eine Liste
  9254.      der angebotenen Datentypen (<>"ARGS").
  9255.   3. FUNCTION cut_left_str(VAR in$,out$) arbeitet 
  9256. hnlich, wie die C-
  9257.      Funktion strtok() mit dem Trennzeichen " " (Space) und liefert
  9258.      als Return die L
  9259. nge von out$. In out$ steht anschlie
  9260. end der
  9261.      erste String aus in$ von links bis zum ersten Space (oder in$,
  9262.      falls kein Space enthalten ist) und in in$ der Rest von in$ nach
  9263.      dem Abschneiden von out$. Ach was soll's(!smile) Hier ist das
  9264.      auch noch: 
  9265.      (K
  9266. nnte man nat
  9267. rlich wie strtok() noch auf andere Trennzeichen
  9268.      ausweiten.)
  9269.   4. chk_pipe() liefert eine 0, wenn nicht der Datentyp ARGS
  9270.      (Kommandozeile) vorliegt oder sonst ein Fehler mit der Pipe
  9271.      auftritt, und ist auch nur f
  9272. r ARGS ausgelegt (ich glaube, ich
  9273.      dreh das nochmal um, damit im Fehlerfall ein Wert <>0 k
  9274. mmt).
  9275.   5. Die symbolischen Konstanten entsprechen ihren gro
  9276.      Namensbr
  9277. dern aus der C-Welt (DD_OK, DD_EXT, usw.).
  9278.   6. Die fxxxx()-Funktionen rufen die entsprechenden 
  9279.  -I/O-
  9280.      Funktionen auf und liefern im Fehlerfall einen Wert <>0
  9281.      (Fehlerbehandlung ist in den Funktionen enthalten). Die letzte 0
  9282.      bei fwrite() hei
  9283. t 'kein CRLF'.
  9284.   7. Den genauen Durchblick habe ich da im Moment auch nicht mehr,
  9285.      aber ich wei
  9286.  ich's irgendwann selbst programmiert habe und
  9287.      da
  9288.  es funktioniert(!smile)
  9289. Bei Fragen kann ich mir das Protokoll ja nochmal genauer angucken!
  9290. lxacc_mtosinit                                                 GFA-Util
  9291. Autor: 
  9292. ,Reiner Rosin @ WI2
  9293. PROCEDURE xacc_mtosinit
  9294.   LOCAL puffer,mode
  9295.   INLINE puffer,20
  9296.   mode=0
  9297.     '
  9298.     GCONTRL(0)=18
  9299.     GCONTRL(1)=1
  9300.     GCONTRL(2)=3
  9301.     GCONTRL(3)=1
  9302.     GCONTRL(4)=0
  9303.     GINTIN(0)=mode
  9304.     ADDRIN(0)=puffer
  9305.     '
  9306.     GEMSYS
  9307.     '
  9308.     EXIT IF GINTOUT(0)<>1
  9309.       '
  9310.       PRINT "ID: ";+GINTOUT(2);"  ";LEFT$(CHAR{puffer}+"         ",10);"Typ:";GINTOUT(1)
  9311.       '
  9312.     ENDIF
  9313.     '
  9314.     mode=1
  9315.   LOOP
  9316. RETURN
  9317.                                
  9318.                                 
  9319.                                
  9320.                           
  9321.                      
  9322.                                                        
  9323. 8Aktuellen Pfad ermitteln                                 
  9324.                                                      
  9325.                                  
  9326.                                 
  9327.                       
  9328.         
  9329.                                            
  9330.                                               
  9331.                       
  9332.                                              
  9333.                      
  9334.                      
  9335.                                     
  9336.                                         
  9337.          
  9338.                          
  9339.                   
  9340.                                       
  9341.                                         
  9342.                                          
  9343.                                        
  9344.                    
  9345.                                                  
  9346.                   
  9347. JBei bestehender Datei die Extension 
  9348. ndern               
  9349.                                        
  9350.                                              
  9351.                                 
  9352.                                          
  9353. ;Blinken der Laufwerkslampen                              
  9354.                                                  
  9355.                                                 
  9356.                                                  
  9357.                                             
  9358.                                                 
  9359.                                        
  9360.                                           
  9361.                              
  9362.                         
  9363.                                                  
  9364.                                 
  9365.                             
  9366.                             
  9367.                              
  9368.                              
  9369.                                                    
  9370.                                                    
  9371.                                         
  9372.                                                  
  9373.                               
  9374.                                                      
  9375.                                             
  9376. ?Datei kopieren (nach Duchalski)                          
  9377. >Datei kopieren1 (nach Gruszka)                           
  9378. >Datei kopieren2 (nach Gruszka)                           
  9379. 5Datei-Infos ermitteln                                    
  9380.                                             
  9381.                                               
  9382. 9Dateiextender extrahieren                                
  9383.                                            
  9384.                                       
  9385.                                          
  9386.                                          
  9387.                                             
  9388.                                                   
  9389.                                                   
  9390.                                       
  9391.                       
  9392.                               
  9393.                              
  9394.                                                 
  9395. /Disknamen lesen                                          
  9396. 3Disknamen schreiben                                      
  9397.                                                   
  9398.                                                  
  9399.                                   
  9400.                                  
  9401.                                   
  9402.                                              
  9403.                                              
  9404.                               
  9405.                
  9406.                                         
  9407.                                           
  9408.                                
  9409.                                        
  9410.                                          
  9411.                                         
  9412.         
  9413.                    
  9414.                    
  9415.                                   
  9416.                                           
  9417.                                               
  9418.                                                    
  9419.                                              
  9420.                                             
  9421. ?Existenz eine Laufwerkes pr
  9422. fen                          
  9423. <Existenz eine Ordners pr
  9424. fen                             
  9425.                                                     
  9426. NExtender zwangsweise(!) vorgeben (nach Harder)           
  9427. OExtender zwangsweise(!) vorgeben (nach Wedding)          
  9428. >Extrahiert den Pfad ohne Datei                           
  9429. CExtrahiert die Datei aus einem Pfad                      
  9430.                                                 
  9431.                                                   
  9432.                                                   
  9433.                                                  
  9434.                                                   
  9435.                                                  
  9436.                                                  
  9437.                                                 
  9438.                                                    
  9439.                                                  
  9440.                                                   
  9441.                                                    
  9442.                                                    
  9443.                                                  
  9444.                                                   
  9445.                                                    
  9446.                                                   
  9447.                                                   
  9448.                                                  
  9449.                                                
  9450.                                                 
  9451.                                                  
  9452.                                                   
  9453.                                                 
  9454.                                               
  9455.                     
  9456. 4FASTLOAD-Flag setzen                                     
  9457. 8FASTLOAD-Flag 
  9458. berpr
  9459. fen                                 
  9460.                                          
  9461.                                                    
  9462.                                                   
  9463.                                             
  9464.                                            
  9465. 5Filenamen formatieren                                    
  9466.                       
  9467.                                                  
  9468.                                               
  9469.                                                  
  9470.                                         
  9471.                                 
  9472.                                                     
  9473.                                              
  9474.                                             
  9475.                                            
  9476.                                 
  9477.                                              
  9478.                                           
  9479. te Versionsnummer verschiedener Files ausgeben       
  9480.                                  
  9481.                                            
  9482.                                                    
  9483. *k2_adresse                                               
  9484. (k2_close                                                 
  9485. 'k2_copy                                                  
  9486. 0k2_copy_and_quit                                         
  9487. )k2_delete                                                
  9488. 2k2_delete_and_quit                                       
  9489. )k2_dialog                                                
  9490. -k2_dst_select                                            
  9491. 'k2_err$                                                  
  9492. 'k2_exec                                                  
  9493. 'k2_exit                                                  
  9494. 'k2_init                                                  
  9495. -k2_init_texte                                            
  9496. )k2_konfig                                                
  9497. )k2_select                                                
  9498. -k2_src_select                                            
  9499.                           
  9500.                          
  9501.                                       
  9502.                                         
  9503.                                          
  9504.                         
  9505. ELange Dateinamen k
  9506. rzen (nach Dunkel)                    
  9507. ELange Dateinamen k
  9508. rzen (nach Klasen)                    
  9509. DLange Dateinamen k
  9510. rzen (nach R
  9511. ger)                     
  9512.                            
  9513.                                     
  9514.                                  
  9515.                              
  9516.                                                  
  9517.                                             
  9518.                                                       
  9519.                                                 
  9520.                                             
  9521.                                             
  9522.                                     
  9523.                                    
  9524.                                 
  9525.                                       
  9526.                                      
  9527.                                                      
  9528.                                     
  9529.                                      
  9530.                                                    
  9531.                                                    
  9532.                                                
  9533.                                                
  9534.                                             
  9535.                                                
  9536.                                               
  9537.                                            
  9538.                                   
  9539.                                           
  9540.                                                  
  9541.                                      
  9542.                                                   
  9543.                                                    
  9544.                                            
  9545.                                               
  9546.                                           
  9547.                                                    
  9548.                                                   
  9549.                                             
  9550.                                       
  9551.                         
  9552.                                                
  9553.                                                 
  9554.                              
  9555.                                
  9556.                           
  9557.                                    
  9558.                                                
  9559.                                          
  9560.                                           
  9561.                                          
  9562.                                       
  9563.                                   
  9564.                        
  9565.                        
  9566.                                             
  9567.                                                   
  9568.                                 
  9569.                                
  9570.                                
  9571.                               
  9572.                               
  9573.                               
  9574.                                                
  9575. 4Schreibschutz testen                                     
  9576.                                                 
  9577.                                                  
  9578.                                               
  9579.                                              
  9580.                                            
  9581.                                             
  9582.                                            
  9583.                          
  9584.                                        
  9585.                                                  
  9586.                                   
  9587.                                         
  9588.                                                    
  9589.                                            
  9590.                                            
  9591.                                              
  9592.                                       
  9593.                                                     
  9594.                              
  9595.                
  9596.                            
  9597.                 
  9598.                                           
  9599.                                     
  9600.                                     
  9601.                     
  9602.                         
  9603.                                                 
  9604.                           
  9605.                                                  
  9606.                                                 
  9607.                                                 
  9608.                      
  9609.                   
  9610.                         
  9611.                                                  
  9612.                                                        
  9613.                                                   
  9614.                                              
  9615.                                               
  9616.                                      
  9617.                                                    
  9618.                                               
  9619.                                                
  9620.                                                
  9621.                               
  9622.                                         
  9623.                                       
  9624.                                              
  9625.                                                       
  9626.                                            
  9627.                                       
  9628.                                  
  9629.                                 
  9630.                                 
  9631.                                    
  9632.                                           
  9633.                              
  9634.                                               
  9635.                                            
  9636.                                            
  9637.                                            
  9638. 5UUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUU\
  9639. UUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUU
  9640. UUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUU
  9641. UUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUU@
  9642. UUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUU@
  9643. UUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUU@
  9644. UUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUU@*
  9645. UUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUU@*
  9646. UUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUU@
  9647. UUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUU@
  9648. UUUU@
  9649. UUUUP
  9650. UUUUU@*
  9651. UUUUU@
  9652. UUUUU@
  9653. UUUUW
  9654. UUUUU@*
  9655. UUqUUZ
  9656. UUUUU
  9657. UUUUU@*
  9658. UU]UUJ
  9659. UUUUUj
  9660. UUa_U^
  9661. UUUUU@e
  9662. UU]UUo
  9663. UUUUUj
  9664. UUa]U^
  9665. UUUUU@*
  9666. UU]UU'
  9667. UUUUUj
  9668. UUa]U^
  9669. UUUUU@
  9670. UUUUU
  9671. UUUUUj
  9672. UUaUU^
  9673. UUUUU@
  9674. UUUUU
  9675. UVUUT
  9676. UUUUUj
  9677. UUaUU^
  9678. UUUUU@*
  9679. UUUUU
  9680. URUUV
  9681. UUUUj
  9682. UUaUU^
  9683. UUUUU@i
  9684. UUUUj
  9685. UUaUU^
  9686. UUUUU@i
  9687. UUZUz
  9688. UUUUj
  9689. UUaUU^
  9690. UUUUU@i
  9691. U^UUIUz
  9692. UUUUj
  9693. UUaUU^
  9694. UUUUU@a
  9695. UWUUh
  9696. UUaUU^
  9697. UUUUU@e
  9698. UWUU%U^
  9699. UUaUU^
  9700. UUUUU@
  9701. UUeUU^
  9702. UUUUU@o
  9703. UUEUU@m
  9704. UUUUz
  9705. UUZUUU
  9706. /UUUZ
  9707. UUU@*
  9708. UUU@*
  9709. UUUU_
  9710. UUUUW
  9711. UUU@x
  9712. UUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUU@*
  9713. UUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUU@
  9714. UUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUU@n
  9715. UUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUU@m
  9716. UUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUU
  9717. UUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUU
  9718. 5UUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUU\
  9719.